子エンティティビューに親情報を表示する

子エンティティの一覧（ビュー）に、親エンティティの情報を表示できる　とのことです。

シナリオ:  * 部署エンティティと従業員エンティティがある
 * 部署対従業員は１対多
 * 部署エンティティにある代表電話を従業員エンティティの一覧に表示する

まず、部署フォームに、部署名と代表電話を追加する。

人事部と総務部とそれぞれの代表電話を登録する。



次に、従業員フォームに、氏名と所属を追加する。

従業員一覧をカスタマイズします。
下記列を追加する画面で、エンティティを選択できることがわかります。
そこに、親エンティティである部署「所属（部署）」という名前で表示されています。


所属（部署）を選択すると、部署エンティティの列を選択できます。ここで、代表電話を選択します。

こんなイメージで、従業員の一覧に、親エンティティである部署の代表電話が表示されます。

以上

カスタムボタンをフォームに追加する

DynamicsCrm2011では、ボタンは基本的リボンに配置しますが、複数参照入力など、ボタンをフォームに配置したいときがあります。

今回は、ボタンをフォームに配置する方法を紹介します。

手順：
1.SilverLightボタンを作成します。
2.作成されたボタンをWebリソースにアップロードします。
3.フォームカスタマイズ画面で、ボタンを追加します。

早速、ボタンはこんなイメージで追加されます。

管理者の右は追加されたボタン

詳細説明

1.SilverLightボタンを作成します。

ボタンを作成するため、以下ツールを使用します。
・VisualWebDeveloper2010 Express
・MicroSoft SilverLight4.0

ボタンの作成手順
1-1.Silverlightアプリケーションを作成します。
※プロジェクト名は「button」とします。

1-2.デフォルトページ（MainPage.xaml）に、SilverLightコントロールのボタンを追加します。

1-3.ボタン名を「カスタムボタン」と設定して、右の余白、上の余白をセロに設定します。

1-4.コンパイルします。
コンパイルが正常できたら、
...Visual Studio 2010\Projects\button\button\Bin\Debugに、
button.xapというファイルが作成されます。これがボタンです。

2.作成されたボタンをWebリソースにアップロードします。
button.xapをWebリソースにアップロードします。

3.フォームカスタマイズ画面で、ボタンを追加します。
任意のフォームカスタマイズ画面を開いて、リボンの追加タブのWebリソースで、ボタンを追加します。

アップロードされたボタン「new_custombutton」が選択候補
になっている

以上

インタネットデータを取得して一覧にするマクロ

製品のスペック、価格、メーカなどの情報をインタネットで調べて、一覧表に纏めたいときがあります。地道で手間のかかる作業です。今回は、この作業を半自動化するマクロを紹介します。

作業の流れは

1.WebページのURLを入手します

2.Webページをエクセルで開く

3.エクセルで開いたWebページのデータをファイルに出力します

4.出力されたファイルをもとに、一覧表を作成します

※作業の2～4はマクロがやってくれます。
※一覧表の作成はユーザ定義一覧を作成するマクロを使用します。

画面はこうなります。

画面の操作を紹介します。
1.URLを入力して、「取得」ボタンにて、インタネットデータを表示します。
※画面の８行目以降
2.Webページ全体を取得するのか、ページの中の表だけを取得するのかを指定できます。
2.出力パスボタンにて、ファイルの格納先を指定します。
3.ファイル名に値またはセルアドレスを指定します。ファイル名は「名前_日付」になります。
4.「ファイル出力」ボタンにて、現在表示しているWebデータをエクセルファイルに出力します。

ソースはこうなります。

''************************************************
'画面の「取得」ボタンから呼び出される
'************************************************
Sub GetWebData()

    Dim strUrl As String
    Dim intLastrow As Integer
    Dim strFileName As String
    Dim strPageType As String
 
    If Range("B1").Value = "" Then Exit Sub
 
    strUrl = Range("B1").Value
    strWebTable = Range("B2").Value
    strFileName = Range("B5").Value
 
    If Range("A2").Value = "表のみ" Then
        strPageType = xlAllTables
    Else
        strPageType = xlEntirePage
    End If
 
    intLastrow = Range("C10000").End(xlUp).Row
 
    '既存データをクリア
    If intLastrow > 8 Then
     
        ThisWorkbook.Sheets("GetWebData").Rows("8:" & intLastrow).Delete shift:=xlUp
 
    End If
 
    'Webデータをダウンロードする
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & strUrl, Destination:=Range("$C$8"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = False
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = strPageType
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
 
    Range("B5").Value = strFileName
 
End Sub

'************************************************
'画面の「ファイル出力」ボタンから呼び出される
'************************************************
Sub CreatWebDataFile()
    Dim objApp As Object     'Excelアプリ
    Dim objBook As Object    'ExcelBook
    Dim objSheets As Object  'ExcelSheets
    Dim strMsg As String     'エラーメッセージ
    Dim strWebDataFileName  As String  '保存Excelファイル
    Dim xlNormal As Integer
 
    Dim intLastrow As Integer

    xlNormal = -4143

    If Range("B4").Value = "" Then Exit Sub
    If Range("B5").Value = "" Then Exit Sub
    If Range("C8").Value = "" Then Exit Sub

    'フルパス付きファイル名
    strWebDataFileName = Range("B4").Value & "\" _
                         & Range("B5") & "_" & _
                         Format(Date, "yyyymmdd")

    intLastrow = Range("C10000").End(xlUp).Row
 
    On Error Resume Next
    Err.Clear

    Set objApp = CreateObject("Excel.Application")

    If Err Then
    'エラー処理
        strMsg = strMsg & "Excelを起動できませんでした" & vbCrLf
        strMsg = strMsg & "Err.Number:" & Err.Number & vbCrLf
        strMsg = strMsg & "Err.Description:" & Err.Description & vbCrLf
    End If

    If strMsg <> "" Then
     
        'エラーメッセージの表示
        MsgBox strMsg, vbCritical, "Excel の作成"
 
    Else
 
        '新規ワークシートを作成
        objApp.Workbooks.Add
     
        '非表示にする
        objApp.Application.Visible = False
     
        '確認ダイアログを表示させない
        objApp.DisplayAlerts = False
     
        Set objBook = objApp.ActiveWorkbook
        Set objSheets = objBook.Worksheets
     
        'シート1のみ残して後は削除
        For i = 2 To objSheets.Count
            objBook.Sheets(i).Delete
        Next
     
        'データをコピーする
        objSheets(1).Range("A1:X" & intLastrow - 8).Value = _
             ThisWorkbook.Sheets("GetWebData").Range("C8:Z" & intLastrow).Value
           
        '新規ブックを保存
        objBook.SaveAs Filename:=strWebDataFileName, _
                        FileFormat:=xlNormal, _
                        Password:="", _
                        WriteResPassword:="", _
                        ReadOnlyRecommended:=False, _
                        CreateBackup:=False

        'Excelの終了
        objApp.DisplayAlerts = True        '確認ダイアログを表示させる
        objBook.Close
        objApp.Quit
     
        'オブジェクトの解放
        Set objSheet = Nothing
        Set objSheets = Nothing
        Set objBook = Nothing
        Set objApp = Nothing
        'エラーメッセージの表示
        MsgBox "ファイルを作成しました。", vbInformation, "Excelの作成"

    End If

End Sub

----------

以上

ユーザ定義一覧表を作成するマクロ

複数のファイルから、特定のシートの特定のセルから値を抽出し、一覧表に纏めるマクロを紹介します。

画面はこうなります。

1.ファイル検索画面
対象ファイルを検索してから、「ユーザ定義一覧」にて、処理を始めます。

※埼玉県市区町村別の人口ファイル 

2.設定および処理結果一覧画面
抽出するシート名とセル名を指定します。セルは最大８つまで指定できます。

※市区町村別人口一覧の作成例 

ソースはこうなります。

'***************************************************
'画面の「ユーザ定義一覧」ボタンから呼び出される
'***************************************************
Sub UserDefineList()

    Dim objBook As Variant
    Dim objSheet As Variant 'シート
    Dim strFile As String
   
    Dim intRow As Integer
    Dim intLastRow As Integer
    Dim intLastTableRow As Integer
   
    Dim strCell1 As String
    Dim strCell2 As String
    Dim strCell3 As String
    Dim strCell4 As String
    Dim strCell5 As String
    Dim strCell6 As String
    Dim strCell7 As String
    Dim strCell8 As String

    If ThisWorkbook.Sheets(1).Range("D10").Value = "" Then Exit Sub
    If ThisWorkbook.Sheets("UserDefineList").Range("B2").Value = "" Then Exit Sub
 
    strCell1 = ThisWorkbook.Sheets("UserDefineList").Range("C2").Value
    strCell2 = ThisWorkbook.Sheets("UserDefineList").Range("D2").Value
    strCell3 = ThisWorkbook.Sheets("UserDefineList").Range("E2").Value
    strCell4 = ThisWorkbook.Sheets("UserDefineList").Range("F2").Value
    strCell5 = ThisWorkbook.Sheets("UserDefineList").Range("G2").Value
    strCell6 = ThisWorkbook.Sheets("UserDefineList").Range("H2").Value
    strCell7 = ThisWorkbook.Sheets("UserDefineList").Range("I2").Value
    strCell8 = ThisWorkbook.Sheets("UserDefineList").Range("J2").Value

    'ファイル一覧の最終行を求める
    intLastTableRow = ThisWorkbook.Sheets("UserDefineList").Range("B10000").End(xlUp).Row
 
    '既存の表のをクリアする
    intLastTableRow = ThisWorkbook.Sheets("UserDefineList").Range("B4").End(xlDown).Row
    If intLastTableRow > 4 Then
        ThisWorkbook.Sheets("UserDefineList").Range("B5:J" & intLastTableRow).Value = ""
        ThisWorkbook.Sheets("UserDefineList").Range("B5:J" & intLastTableRow).　_
                                                                    Borders.LineStyle = xlLineStyleNone
 
    End If

    '画面更新を無効にする
    Application.ScreenUpdating = False

 
    'メッセージ表示を無効にする
    Application.DisplayAlerts = False
 
    intRow = 4

    'ファイル毎の処理
    For i = 10 To intLastRow
   
        strFile = ThisWorkbook.Sheets(1).Cells(i, 4).Value

        If Right(strFile, 3) = "xls" Or Right(strFile, 4) = "xlsx" Then

            'ファイルをセットする
            Set objBook = Application.Workbooks.Open(strFile)
       
            'シート毎の処理
            For Each objSheet In objBook.Sheets
           
                If objSheet.Name = ThisWorkbook.Sheets("UserDefineList").Range("B2").Value Then
                 
                    intRow = intRow + 1
                 
                    ThisWorkbook.Sheets("UserDefineList").Cells(intRow, 2).Value = objBook.Name
                 
                    '1列目
                    If strCell1 <> "" Then
                        ThisWorkbook.Sheets("UserDefineList").Cells(intRow, 3).Value = _
                                                                       objSheet.Range(strCell1).Value
                    End If
                 
                    '2列目
                    If strCell2 <> "" Then
                        ThisWorkbook.Sheets("UserDefineList").Cells(intRow, 4).Value = _
                                                                       objSheet.Range(strCell2).Value
                    End If
                 
                    '3列目
                    If strCell3 <> "" Then
                        ThisWorkbook.Sheets("UserDefineList").Cells(intRow, 5).Value = _
                                                                       objSheet.Range(strCell3).Value
                    End If
                 
                    '4列目
                    If strCell4 <> "" Then
                        ThisWorkbook.Sheets("UserDefineList").Cells(intRow, 6).Value = _
                                                                       objSheet.Range(strCell4).Value
                    End If
                 
                    '5列目
                    If strCell5 <> "" Then
                        ThisWorkbook.Sheets("UserDefineList").Cells(intRow, 7).Value = _
                                                                       objSheet.Range(strCell5).Value
                    End If
                 
                    '6列目
                    If strCell6 <> "" Then
                        ThisWorkbook.Sheets("UserDefineList").Cells(intRow, 8).Value = _
                                                                       objSheet.Range(strCell6).Value
                    End If
                 
                    '7列目
                    If strCell7 <> "" Then
                        ThisWorkbook.Sheets("UserDefineList").Cells(intRow, 9).Value = _
                                                                       objSheet.Range(strCell7).Value
                    End If
                 
                    '8列目
                    If strCell8 <> "" Then
                        ThisWorkbook.Sheets("UserDefineList").Cells(intRow, 10).Value = _
                                                                       objSheet.Range(strCell8).Value
                    End If
                 
             
                Exit For
                End If
             
            Next objSheet
         
            '表に罫線をかける
            ThisWorkbook.Sheets("UserDefineList").Range("B4:J" & intRow). _
                                                          Borders.LineStyle = xlContinuous
       
            'ファイルクローズ
            objBook.Close savechanges:=False
               
        End If
       
    Next i

    'メッセージ表示を有効にする
    Application.DisplayAlerts = True

    '画面更新を有効に戻す
    Application.ScreenUpdating = True

    'シート処理結果をアクティブにする
    ThisWorkbook.Sheets("UserDefineList").Activate

    ' 処理完了(結果表示)
    MsgBox "処理が完了しました。"

End Sub

----------
以上

複数エクセルファイルの取消文字列を一括削除するマクロ

仕様書の変更箇所を分かりやすくするために、変更履歴、取消線、文字色などが活用されています。やがて、文字色を統一し、変更履歴や取消線で消された文字を削除し、納品物に仕上げます。

今回ご紹介するマクロは
・セルの全部、または一部が取消線でマークされている文字列を削除します。
・処理結果を記録します。

画面はこうなります。

1.処理開始画面
処理対象ファイルを検索してから、一括削除する流れで操作します。
取消線でマークされた文字列を一セルずつ検索するので、セルの範囲を指定して、スピードアップをはかります。

2.処理結果画面

下図６列で処理結果を把握します。

ソースはこうなります。

'***************************************************
'画面の「取消文字を一括削除」ボタンから呼び出される
'***************************************************
Sub DelStrikeOutWords()

    Dim objBook As Variant
    Dim objSheet As Variant 'シート
    Dim strFile As String
   
    Dim intRow As Integer
    Dim intLastRow As Integer
   
    Dim intCount As Integer
    Dim celCell As Variant

    Dim chaChar As Characters
    Dim strResult As String
    Dim strDelWord As String
    Dim strRange As String

    If ThisWorkbook.Sheets(1).Range("D10").Value = "" Then Exit Sub

    '最終行を求める
    intLastRow = ThisWorkbook.Sheets(1).Range("D9").End(xlDown).Row

    '画面更新を無効にする
    Application.ScreenUpdating = False

    '削除処理の範囲
    strRange = ThisWorkbook.Sheets(1).Range("S2").Value

    intRow = 1
    ThisWorkbook.Sheets("List").Cells.Clear
    ThisWorkbook.Sheets("List").Cells(intRow, 1).Value = "処理結果一覧"

    intRow = 2
    ThisWorkbook.Sheets("List").Cells(intRow, 1).Value = "削除前"
    ThisWorkbook.Sheets("List").Cells(intRow, 2).Value = "削除文字"
    ThisWorkbook.Sheets("List").Cells(intRow, 3).Value = "削除後"
    ThisWorkbook.Sheets("List").Cells(intRow, 4).Value = "セル"
    ThisWorkbook.Sheets("List").Cells(intRow, 5).Value = "シート"
    ThisWorkbook.Sheets("List").Cells(intRow, 6).Value = "ファイル"


    'メッセージ表示を無効にする
    Application.DisplayAlerts = False

    'ファイル毎の処理
    For i = 10 To intLastRow
   
        strFile = ThisWorkbook.Sheets(1).Cells(i, 4).Value

        If Right(strFile, 3) = "xls" Or Right(strFile, 4) = "xlsx" Then

            'ファイルをセットする
            Set objBook = Application.Workbooks.Open(strFile)
       
            'シート毎の処理
            For Each objSheet In objBook.Sheets
         
                'セル毎の処理
                For Each celCell In objSheet.Range(strRange)

              　　 '数字だと、エラーになるので、文字列だけ処理する
                    If VarType(celCell.Value) = vbString Then
           
                      intCount = Len(celCell)
                      strResult = ""
                      strDelWord = ""
             
                      For j = 1 To intCount
                     
                          Set chaChar = celCell.Characters(j, 1)
                     
                          If chaChar.Font.Strikethrough Then
                       
                             strDelWord = strDelWord + chaChar.Text
                           
                          Else
                       
                            strResult = strResult + chaChar.Text
                         
                          End If
                     
                      Next j
                 
                      If Len(strDelWord) > 0 Then
                     
                          '削除対象文字の一覧を作成する
                          intRow = intRow + 1
                          ThisWorkbook.Sheets("List").Cells(intRow, 1).Value = celCell.Value
                          ThisWorkbook.Sheets("List").Cells(intRow, 2).Value = Trim(strDelWord)
                          ThisWorkbook.Sheets("List").Cells(intRow, 3).Value = Trim(strResult)
                          ThisWorkbook.Sheets("List").Cells(intRow, 4).Value = celCell.Row _
                                                               & "行" & celCell.Column & "列"
                          ThisWorkbook.Sheets("List").Cells(intRow, 5).Value = objSheet.Name
                          ThisWorkbook.Sheets("List").Cells(intRow, 6).Value = objBook.Name
                     
                          '削除後の文字をセットする
                          celCell.Value = Trim(strResult)
                 
                      End If
                 
                    End If
           
                Next celCell
       
            Next objSheet
       
            'ファイルクローズ
            objBook.Close savechanges:=True
               
        End If
       
    Next i

    'メッセージ表示を有効にする
    Application.DisplayAlerts = True

    '画面更新を有効に戻す
    Application.ScreenUpdating = True

    'シート処理結果をアクティブにする
    ThisWorkbook.Sheets("List").Activate

    ' 処理完了(結果表示)
    MsgBox "処理が完了しました。"

End Sub

-----------------------

以上

複数エクセルファイルから特定の単語を検索するマクロ

大量の仕様書から、今日変更された仕様書だけ知りたい。

横展開するとき、漏れのないように修正したい。

基本的なことですが、悩ましいことです。

次の二つのアプローチで、このような悩みを軽減したいと思います。

1.指定したフォルダ（サブフォルダ含む）にあるファイル、およびその更新日時を一覧化します。

→更新日時でソート書けば、いつどのファイルが変更されたのかはすぐ分かります。

2.特定のキーワードがどのファイルのどこに存在するかを一覧化します。

→横展開の範囲を知るための重要手がかりになります。


次のマクロは
・特定フォルダに格納されているファイルの一覧
・特定キーワードを含むファイルの一覧
を作ってくれます。

インタフェースはこうなります。
1.ファイル一覧


2.特定キーワードを使用するファイルの一覧

ソースコードはこうなります。



'***********************************************
'画面の「検索」ボタンから呼び出される
'***********************************************
Sub SearchWords()

    Dim intLastWordRow As Integer
    Dim intLastFileRow As Integer
    Dim intRow As Integer
 
    Dim strSearchType As String
    Dim strTargetWord As String
    Dim strFileName As String

    Dim objBook As Variant
    Dim objSheet As Variant 'シート
    Dim strAddress As String '開始セルアドレス
    Dim TargetCell As Range '検索目的セル
 
    Dim strWkWord As String
    Dim strWkCell As String
    Dim strWkFile As String
    Dim strWkSheet As String
 
 
    '完全一致・部分一致
    If ThisWorkbook.Sheets("SearchWord").Range("C1").Value = "完全一致" Then
        strSearchType = xlWhole
    Else
        strSearchType = xlPart
    End If
 
 
    'ファイル一覧の最終行
    intLastFileRow = ThisWorkbook.Sheets("FileList").Range("D9").End(xlDown).Row
 
    If ThisWorkbook.Sheets("FileList").Range("D10").Value = "" Then
        MsgBox "先にファイルを検索してください。"
        Exit Sub
    End If

 
    '単語一覧の最終行
    intLastWordRow = ThisWorkbook.Sheets("SearchWord").Range("A10000").End(xlUp).Row

    If intLastWordRow < 2 Then
        MsgBox "単語を指定してください。"
        Exit Sub
    End If


    '画面更新を無効にする
    Application.ScreenUpdating = False
 
    '既存の値をクリアする
    '既存検索結果一覧をクリア
    ThisWorkbook.Sheets("SearchWordResult").Cells.Clear
    ThisWorkbook.Sheets("SearchWordResult").Range("A1").Value = "検索結果"
    ThisWorkbook.Sheets("SearchWordResult").Range("A2").Value = "検索値"
    ThisWorkbook.Sheets("SearchWordResult").Range("B2").Value = "セル値"
    ThisWorkbook.Sheets("SearchWordResult").Range("C2").Value = "ファイル名"
    ThisWorkbook.Sheets("SearchWordResult").Range("D2").Value = "シート名"
    ThisWorkbook.Sheets("SearchWordResult").Range("E2").Value = "セルアドレス"

 
    'ファイル毎の処理
    For i = 10 To intLastFileRow
 
        strFileName = ThisWorkbook.Sheets("FileList").Range("D" & i).Value
     
        'エクセルファイルだけ検索する
        If Right(strFileName, 3) = "xls" Or Right(strFileName, 3) = "xlsx" Then
 
            Set objBook = Application.Workbooks.Open(strFileName)
         
            'シート毎の処理
            For Each objSheet In objBook.Sheets
         
                '単語毎の処理
             
                For j = 2 To intLastWordRow
             
                    strTargetWord = ThisWorkbook.Sheets("SearchWord").Range("A" & j).Value
                 
                    '一回目の検索
                    Set TargetCell = objSheet.Cells.Find(strTargetWord, LookAt:=
                                           _ strSearchType, MatchCase:=False, MatchByte:=False)
             
             
                    If Not TargetCell Is Nothing Then
                         
                        strAddress = TargetCell.Address
                        intRow = ThisWorkbook.Sheets("SearchWordResult").Range("A1").
                                     _ End(xlDown).Row
                         
                        Do
                            '見つかった場合の処理
                         
                            intRow = intRow + 1
                            ThisWorkbook.Sheets("SearchWordResult").Cells(intRow, 1). _
                                 Value = strTargetWord
                            ThisWorkbook.Sheets("SearchWordResult").Cells(intRow, 2). _
                                 Value = TargetCell.Value
                            ThisWorkbook.Sheets("SearchWordResult").Cells(intRow, 3). _
                                 Value = objBook.Name
                            ThisWorkbook.Sheets("SearchWordResult").Cells(intRow, 4). _
                                 Value = objSheet.Name
                            ThisWorkbook.Sheets("SearchWordResult").Cells(intRow, 5). _
                                 Value = TargetCell.Row & "行" & TargetCell.Column & "列"
                                     
                            '二回目以降の検索
                            Set TargetCell = objSheet.Cells.FindNext(TargetCell)
                             
                            '対象単語がないとき、または2回目当たったとき、ループから抜け出す
                            If TargetCell Is Nothing Then Exit Do
                            If TargetCell.Address = strAddress Then Exit Do
                             
                        Loop
                         
                    End If
             
             
             
                Next j
     
           Next objSheet
         
         
           '保存せず終了
            objBook.Close savechanges:=False
     
     
        End If
     

    Next i
 
 
    '画面更新を有効に戻す
    Application.ScreenUpdating = True
    ThisWorkbook.Sheets("SearchWordResult").Activate
 
 
    '検索結果一覧表を作成する
 
     'ヘッダー行の罫線と色
    ThisWorkbook.Sheets("SearchWordResult").Range("A2:E2").Borders.LineStyle = xlContinuous
    ThisWorkbook.Sheets("SearchWordResult").Range("A2:E2").Interior.ColorIndex = 20
 
    '検索値列の昇順でソートをかける
    If ThisWorkbook.Sheets("SearchWordResult").Range("A3") <> "" Then
     
        ThisWorkbook.Sheets("SearchWordResult").Range("A3:E" & intRow).Sort                  
                                           _ key1:=Range("A3:A" & intRow), order1:=xlAscending
 
        '重複値を除去し、罫線をかける
        strWkWord = ThisWorkbook.Sheets("SearchWordResult").Range("A3").Value
        strWkCell = ThisWorkbook.Sheets("SearchWordResult").Range("B3").Value
        strWkFile = ThisWorkbook.Sheets("SearchWordResult").Range("C3").Value
        strWkSheet = ThisWorkbook.Sheets("SearchWordResult").Range("D3").Value
     
        For i = 4 To intRow
     
            '検索値列
            If ThisWorkbook.Sheets("SearchWordResult").Range("A" & i).Value = strWkWord Then
         
                ThisWorkbook.Sheets("SearchWordResult").Range("A" & i).Value = ""
         
            Else
         
                ThisWorkbook.Sheets("SearchWordResult").Range("A" & i - 1).Borders _
                                                                   (xlEdgeBottom).LineStyle = xlContinuous
                strWkWord = ThisWorkbook.Sheets("SearchWordResult").Range("A" & i).Value
         
            End If
         
            'セル値列
            If ThisWorkbook.Sheets("SearchWordResult").Range("B" & i).Value = strWkCell Then
         
                ThisWorkbook.Sheets("SearchWordResult").Range("B" & i).Value = ""
         
            Else
         
                ThisWorkbook.Sheets("SearchWordResult").Range("B" & i - 1).Borders _
                                                                   (xlEdgeBottom).LineStyle = xlContinuous
                strWkCell = ThisWorkbook.Sheets("SearchWordResult").Range("B" & i).Value
         
            End If
         
            'ファイル名
            If ThisWorkbook.Sheets("SearchWordResult").Range("A" & i).Value = "" Then
         
                If ThisWorkbook.Sheets("SearchWordResult").Range("C" & i).Value = strWkFile Then
         
                    ThisWorkbook.Sheets("SearchWordResult").Range("C" & i).Value = ""
             
                Else
         
                    ThisWorkbook.Sheets("SearchWordResult").Range _
                          ("C" & i - 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
                    strWkFile = ThisWorkbook.Sheets("SearchWordResult").Range("C" & i).Value
             
                End If
            Else
         
                ThisWorkbook.Sheets("SearchWordResult").Range("C" & i - 1).Borders _
                                                                    (xlEdgeBottom).LineStyle = xlContinuous
                strWkFile = ThisWorkbook.Sheets("SearchWordResult").Range("C" & i).Value
         
            End If
         
            'シート名
            If ThisWorkbook.Sheets("SearchWordResult").Range("C" & i).Value = "" Then
             
                If ThisWorkbook.Sheets("SearchWordResult").Range("D" & i).Value = _
                    strWkSheet Then
                 
                    ThisWorkbook.Sheets("SearchWordResult").Range("D" & i).Value = ""
             
                Else
                 
                    ThisWorkbook.Sheets("SearchWordResult").Range("D" & i - 1 & ":E" & _
                                                       i - 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
                    strWkSheet = ThisWorkbook.Sheets("SearchWordResult").Range("D" & i).Value
             
                End If
            Else
         
                ThisWorkbook.Sheets("SearchWordResult").Range("D" & i - 1 & ":E" & _
                                                       i - 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
                strWkSheet = ThisWorkbook.Sheets("SearchWordResult").Range("D" & i).Value
         
            End If

        Next i
 

        '列に罫線をかける xlEdgeTop xlEdgeBottom
        ThisWorkbook.Sheets("SearchWordResult").Range("A2:A" & _
                                               intRow).Borders(xlEdgeLeft).LineStyle = xlContinuous
        ThisWorkbook.Sheets("SearchWordResult").Range("A2:A" & _
                                               intRow).Borders(xlEdgeRight).LineStyle = xlContinuous
     
        ThisWorkbook.Sheets("SearchWordResult").Range("C2:C" & _
                                               intRow).Borders(xlEdgeLeft).LineStyle = xlContinuous
        ThisWorkbook.Sheets("SearchWordResult").Range("C2:C" & _
                                               intRow).Borders(xlEdgeRight).LineStyle = xlContinuous
     
        ThisWorkbook.Sheets("SearchWordResult").Range("E2:E" & _
                                               intRow).Borders(xlEdgeLeft).LineStyle = xlContinuous
        ThisWorkbook.Sheets("SearchWordResult").Range("E2:E" & _
                                               intRow).Borders(xlEdgeRight).LineStyle = xlContinuous
     
        ThisWorkbook.Sheets("SearchWordResult").Range("A" & intRow & ":E" & _
                                               intRow).Borders(xlEdgeBottom).LineStyle = xlContinuous
        ThisWorkbook.Sheets("SearchWordResult").Range("A3:E" & intRow). _
                                               VerticalAlignment = xlTop
 
    End If

    ' 処理完了(結果表示)
 
    MsgBox "処理が完了しました。"

End Sub


--------------
以上

同一タスクで複数担当者を対応する「マイタスク」ビュー

ログインユーザが担当しているタスクを一覧表示するのがここでいう「マイタスク」ビューです。
同じタスクに、複数の担当者がいる場合の、「マイタスク」ビューの実現方法を紹介します。

次の業務要件を想定します。
・タスクは営業案件というエンティティに格納します。
・担当者はユーザというエンティティに格納します。

・一営業案件に、複数の担当者がいます。
・一担当者が、複数の営業案件を担当します。

・営業案件の担当者は画面で追加、または削除できるとします。
・「マイタスク」ビューで、ログインユーザが担当しているタスクを表示します。

実現手順は次の通りになります。

手順1：
営業案件とユーザのN:N関連付けを作ります。
※担当者というエンティティが自動的に作成されます。

手順2：

営業案件フォームに、担当者subグリッドを追加します。

出来上がったフォーム画面はこのようになります。

手順3：

マイタスクビューを作成します。

営業案件エンティティから、関連エンティティである担当者経由で、ユーザエンティティに辿り着き、

ユーザがログインユーザに等しいと設定します。

ここまで、作業完了です。次に、動作確認をします。

動作確認するためのデータを次のように作っておきます。

確認1：

担当者Aでログインする場合に、マイタスクビューに、営業案件１と営業案件２が表示されます。

確認2：

担当者Bでログインする場合に、マイタスクビューに、営業案件１だけ表示されます。

以上

フィールド共有を設定するための権限構成

ログインユーザがフィールド共有を設定できるように、セキュリティロールの構成を紹介します。

フィールド共有はレコード共有の一部なので、フィールド共有するために、まずレコード共有するための権限が必要です。下図右側の「共有」列で設定します。

フィールド共有の設定情報は、「フィールド共有」というエンティティに格納されます。フィールド共有設定は、「フィールド共有」エンティティに、共有情報を追加すると考えていいです。

一つのフィールドを複数のユーザ、または複数のチームに共有できるので、以下４エンティティのへ権限を適切に構成すれば、この権限を持つユーザがフィールド共有を設定できるようになります。
・共有フィールドエンティティ
・共有対象フィールが含まれるエンティティ
・ユーザエンティティ
・チームエンティティ

また、共有しようとするセキュリティフィールドの特権を持たないといけません。

では、以下シナリオの設定を確認します。
・「フィールド共有テキスト」というエンティティがあります。
・「セキュリティ項目」というセキュリティフィールドが前記エンティティにあります。
・ユーザAに、「営業課長」というセキュリティロールを付与します。
・ユーザAが、フィールド共有設定できるよう、権限を与えます。

1.セキュリティロール設定画面で、下表の要領で設定します。

※アクセスレベルは全て組織全体とします

「追加」と「追加先」の意味はセキュリティロールの追加と追加先を検証をご参照ください。

2.セキュリティフィールドプロファイルにて、読込と更新を「あり」にします。

以上要領で設定したセキュリティロールとセキュリティフィールドプロファイルが付与されたユーザがフィールド共有を設定できるようになります。

以上

レコードの所有者であるユーザとチームの違い

1.レコード所有者の基本

エンティティの属性である「企業形態」を「ユーザまたはチーム」に設定した場合に、「所有者」というフィールドが自動的に作成されます。

所有者はレコードの所有者のことです。ユーザまたはチームになります。デフォルト所有者はユーザです。また、部署は「既定のチーム」として、レコードの所有者に設定できます。

レコードの所有者と、所有者の部署を使い合わせて、エンティティへのアクセスレベルを5段階で構成できます。
・選択なし、ユーザ、部署、部署配下、組織全体

逆に、レコードに所有者がない場合、エンティティへのアクセスレベルは2段階でしか構成できません。
・選択なし、組織全体

2.所有者をチームにする場合の注意点

データを新規登録するとき、デフォルトの所有者はログインユーザになっているので、ログインユーザのチームに書き換えると、カスタマイズが必要です。

このため、以下運用的な協力も必要です。
・ユーザを事前にチームに登録しておく
・同じユーザを複数のチームに登録した場合、どのチームをデフォルト所有者にするのかを決めておく

また、ユーザとチーム両方に、セキュリティロールを設定しなければいけません。
データの閲覧にログインユーザの権限が聞かれます。データを保存するときに、所有者であるチームの権限が求められます。

3.所属異動と組織変更への対応

所有者がユーザ、チーム別に、所属異動時と部署統廃合時に必要な処理を下表に纏めています。

レコードの割り当てはエンティティ毎に行うので、エンティティ数とデータ量の多い場合、大変な操作になります。

よって、部署統廃合が多い組織では、所有者をユーザに、所属異動の多い組織では、所有者をチームにすると検討してはいかがでしょうか。

以上

複数の部署を動的に検索する

まず、検索条件を動的に設定できる項目を確認します。

1.個々のエンティティに存在する動的検索可能項目および条件

2.個々のエンティティから、関連エンティティ経由で設定できる動的に検索可能項目および条件

上記2つの表が示すように、ログインユーザの所属部署を動的に、検索条件に追加できます。
Dynamicsでは、ユーザはただ一つの部署に所属するので、一つの部署だけ、検索条件に追加できることも分かります。

ここで、部署とチームをフルに活用して、複数の部署を動的に検索する方法を紹介します。

まず、下図のように、組織を構成します。

この組織構造を説明します。
・ユーザをチームに所属させます。Dynamicsでは任意ですが、ここでは必須です。
・ユーザを部署に所属させます。Dynamicsでは必須です。
・チームを部署に所属させます。Dynamicsでは必須です。
・Dynamicsのチームを実務の中の部署として使います。

更に、レコードの所有者(OwnerId)はチームとします。

こうすると、ユーザ、組織、データの関係は次のようになります。

最後に、
ビューのフィルター条件で、「所有チーム（チーム）の部署が現在の部署に等しい」と設定します。

チームを部署と見直せば、複数部署を動的に検索できるようになったと思いませんか。

以上

チームからのセキュリティロール継承

Dynamicsでは、ユーザにも、チームにもセキュリティロールを付与できます。ユーザが複数のセキュリティロールを持つ場合、もっとも制限のゆるい権限が適用されることになります。

ユーザをチームに追加した場合、チームとユーザのセキュリティロールの付与方法は三つのケースに分けられます。

※○：付与する　×：付与しない

ケース1では、二つのセキュリティロールがユーザに付与することになり、最も制限のゆるい権限が適用されることを確認できています。

ケース2は一般的な運用パターンです。
一つだけ注意するところがあります。レコードをチームに割り当てて保存すると、エラーになります。チームに、レコードを持つための作成権限がないからです。適切なセキュリティロールをチームに付与すれば、問題解決です。

ケース3では、ユーザにセキュリティロールがありません。チームのセキュリティロールを継承できるかどうかは今回のテイマです。

まず、以下要領で、セキュリティロール、チーム、ユーザを作ります。
・セキュリティロール名：試験ロール　　※取引先企業に、組織全体の読取権限だけ設定
・チーム名：試験チーム
・ユーザ名：試験ユーザ　　※試験チームに追加

つぎに、検証を三つ行います。

検証1：
試験チームにシステム管理者ロールを付与します。
試験ユーザにセキュリティロールを付与しません。

以下の検証結果を確認できました。
・試験ユーザは正常にログインできます。
・一覧画面を開けます。
・フォーム画面を開けません。

よって、ユーザにセキュリティロールを付与しない場合、チームの権限を不完全継承できます。

検証2：
検証１の続きです。試験ユーザに、試験ロールを付与します。

以下検証結果を確認できました。
・試験ユーザはシステム管理者のすべて操作を行えます。

よって、ユーザにセキュリティロールを付与すれば、チームの権限を完全に継承できます。
※検証2で、取引先企業の作成・修正・削除を正常に行いました。

検証3：
検証2の続きです。試験ユーザから、試験ロールを削除します。

検証1と同じ結果になると思いましたが、そうではなかった。
検証2で行った取引先企業の作成・修正・削除は引き続きできます。
他の画面については検証1と同じ結果になります。

よって、権限の設定が不可逆になってしまうときがあります。これは不備でしょう。

最後に、下記結論を纏めます。
・ユーザにセキュリティロールの設定は必須です。
・ユーザにセキュリティロールを設定すれば、チームのセキュリティロールを継承できます。

以上

エンティティ関連付けのデータ構造 （N：N）

二つのエンティティに、N：N関連付けを作成すると、関連情報を格納する「関連エンティティ」が自動的に作成されます。

関連エンティティを画面経由でアクセスできません。データベースを直接確認すると、以下４列で構成されいることがわかります。
・.一つ目のエンティティのレコードID
・二つ目のエンティティのレコードID
・システムユーザID
・バージョンナンバー

N対Nの関連を持つ部署と従業員を例に、N：N関連付けの作成画面を確認します。

関連エンティティ名項目が設けられていることから、エンティティが作成されていることがわかります。表示オプションは、フォームナビゲーションに、相手エンティティのサブグリッド画面に遷移するリンクを表示するかどうかの選択です。

Dynamicsでは、エンティティ間の関連付けを確認しやすいように、N：N関係を持つエンティティのどちらからでも、関連付を確認できます。

関連エンティティに、N：N関係を持つ二つのエンティティのレコードID（外部キー）を格納します。データの追加と削除は次のタイミングで行われます。

例の部署と従業員を用いて説明すると、
・部署に、従業員を追加、または削除するとき
・従業員に、部署を追加、または削除するとき

１：N関連と違って、部署データまたは従業員データを新規作成するとき、相手データと関連付けできません。必ずデータを作成してから、追加する形で、関連付けしなければいけません。

また、部署から、従業員を削除すること、または従業員から部署を削除することは、関連エンティティのデータを削除することです。決して従業員、または部署そのものを削除するわけではないことを理解すれば、N：Nの関連付けは理解できていると思います。

エンティティ関連付けのデータ構造 （１：N）

「１：N」関連付けを理解するには、「関連名」と「検索フィールド」を抑えればいいと思います。

一つのエンティティに、複数の関連付けを追加できます。関連付けを識別するのに、関連名を使います。Dynamicsでは、親エンティティからでも、子エンティティからでも関連を確認できます。親エンティティから見た「１：N」の関連は子エンティティから見たN：１の関連になります。

検索フィールドは、子エンティティ側が持ちます。親エンティティのレコードID（外部キー)を格納します。

下図は、親エンティティにて、「１：N」関連付けを作成する画面です。

主エンティティが「親」、関連エンティティが「子」なので、親からみて、子と１：Nの関連を持ちます。
この画面に、検索フィールドを設定するので、「親」エンティティに検索フィールドを追加すると誤解しがちですが、検索フィールドは子エンティティに作られることを理解するのが肝心です。

関連名は親からも、子からも確認できる画面を見てみましょう。
下記画面が示している通り、「new_new_oya_new_ko」という関連名は親にも子にもあります。

関連付けと検索フィールドはセットで作られますが、検索フィールドは子エンティティにあることを次の画面で確認できます。

では、子が持っている検索フィールドに、値（親のレコードID）がいつ格納されるのでしょうか。タイミングは二つあります。

一つは、親のフォームナビゲーションから、子を作成するとき、親のレコードIDが自動的に、子が持つ検索フィールドに入ります。

子のフォーム画面に、検索項目を設置しなくても、親のレコードIDが入ります。これは、上記手順で子データを作ると、親から子へのマッピングが動作しているからです。
※マッピングは関連付けを作成するときに、自動的に作られます。

もう一つは、子のフォーム画面に、検索フィールドを設置します。検索入力するときに、親のレコードIDが入ります。



アプリケーションナビゲーションから、子データを作成すると、親画面を経由しないので、マッピングが動作しません。しかし、検索項目を画面に設置することによって、親レコードIDをいつでも追加または削除できます。


最後に、子データの表示を考えます。

アプリケーションナビゲーションから、子エンティティ一覧を表示する場合、親に関わらす、すべての子データを一覧表示できます。

親のフォームナビゲーションから、子データを一覧表示する場合、検索フィールドを、表示中の親のレコードIDで検索し、一致するものだけ表示することになります。

以上

セキュリティロールとレコード共有とフィールド共有

セキュリティロール、レコード共有、フィールド共有といったセキュリティ設定は、
「特権」と「アクセスレベル」をセットで設定して始めて、完了となります。

まず、セキュリティロール、レコード共有、フィールド共有で設定できる項目を確認します。

・セキュリティロール

セキュリティロール設定画面で、八つの特権と五つのアクセスレベルを定義できます。
特権：作成、読み込み、書き込み、削除、追加、追加先、割り当て、共有
アクセスレベル：選択なし、ユーザ、部署、部署配下、組織全体
※「選択なし」は、アクセスレベルを設定しないと考えてください。

・レコード共有

レコード共有設定画面で、六つの特権を設定できます。
特権：読み込み、書き込み、削除、追加、共有

・フィールド共有

フィールド共有設定画面で、二つの特権を設定できます。
特権：読み込み、更新　
※更新は、書き込みと考えてOKです。

以上３つの設定画面から、アクセスレベルを定義できるのは、セキュリティロール設定画面だけであることが分かります。共有で特権を設定しても、アクセスレベル設定を漏れてしまうと、レコードをいじれません。
※レコード共有画面とフィールド共有画面では、特権の追加はできますが、特権の削除はできない見方もあります。

特定のレコードに対して、
・レコード共有で、読み込みと書き込みを
・セキュリティフィールドを、フィールド共有で読み込みと更新
と設定した場合に、書き込みできるようにするため、セキュリティロールで、書き込み特権をユーザ以上のアクセスレベルに設定することが必要です。

以上