VBAのListViewで利用する共通関数(VBAでのListViewの設定方法)

 VBAのListViewが復活したいまさらながらに知ったので、共通関数として必要そうなものをつくってみた。共通モジュールに「modListView」を作って中に放り込んでおけばいろいろと使える・・・はず。

******* 画面での使い方 *******
Private Const COL_1_No As String = "_No"
Private Const COL_2_NAME As String = "_Name"
Private Const COL_3_COUNT As String = "_COUNT"
Private Sub CommandButton2_Click()
    Call SetData
End Sub
Private Sub LvSample_DblClick()
    MsgBox GetLvValueIdx(lvSample, lvSample.SelectedItem.Index, COL_1_No)
End Sub
Private Sub UserForm_Initialize()
    
    Call ControlInit
    
End Sub

Private Sub ControlInit()
    
    Call LvSample_Initialize
End Sub

'ListViewにテストデータを設定する
Private Sub SetData()
    lvSample.ListItems.Clear
    Dim i As Integer
    'データ設定方法1
    For i = 0 To 10
        lvSample.ListItems.Add
            
        Call SetLvValueIdx(lvSample, i + 1, COL_1_No, i)
        Call SetLvValueIdx(lvSample, i + 1, COL_2_NAME, "日本 太郎" & i)
        Call SetLvValueIdx(lvSample, i + 1, COL_3_COUNT, "1")
    Next
    
    'データ設定方法2
    Dim item As ListItem
    For i = 0 To 10
        
        Set item = lvSample.ListItems.Add
        
        Call SetLvValue(lvSample, item, COL_1_ATENA, "2 - " & i)
        Call SetLvValue(lvSample, item, COL_2_NAME, "日本 太郎2 - " & i)
        Call SetLvValue(lvSample, item, COL_3_COUNT, "1")
        '色変更サンプル
        If i = 1 Or i = 5 Then
            item.ForeColor = RGB(255, 0, 0)
        End If
        
        Set item = Nothing
        
    Next
End Sub

Private Sub LvSample_Initialize()
    
    'ListViewの共通プロパティ設定
    Call SetListViewProperty(lvSample)
    
    'ListViewの列を設定する
    With lvSample
        .ColumnHeaders.Add , COL_1_NO, "番号"
        .ColumnHeaders.Add , COL_2_NAME, "名前"
        .ColumnHeaders.Add , COL_3_COUNT, "数"
    End With
End Sub


*****************************

******* modListView の中身********
Public Sub SetListViewProperty(ByRef lv As ListView)
    With lv
        .View = lvwReport           ''表示
        .LabelEdit = lvwManual      ''ラベルの編集
        .HideSelection = False      ''選択の自動解除
        .AllowColumnReorder = True  ''列幅の変更を許可
        .FullRowSelect = False       ''行全体を選択
        .Gridlines = True           ''グリッド線
    End With
End Sub
'----------------------------------------------------------------------------------------------------------
'関数:列名からリストビューの値を取得する
'----------------------------------------------------------------------------------------------------------
Public Function GetLvValue(ByRef lv As ListView, ByRef lvItem As ListItem, ByVal strColKey As String) As String
    GetLvValue = ""
    
    Dim intColIdx As Integer
    intColIdx = GetColIdx(lv, strColKey)
    
    If intColIdx = -1 Then
        MsgBox "[エラー]関数の指定が間違っています。関数名:GetLvValue"
        Exit Function
    End If
    
    If intColIdx = 1 Then
        GetLvValue = lv.ListItems(lngItemIdx).Text
    Else
        GetLvValue = lv.ListItems(lngItemIdx).SubItems(intColIdx - 1)
    End If
    
End Function
'----------------------------------------------------------------------------------------------------------
'関数:列名からリストビューの値を取得する
'----------------------------------------------------------------------------------------------------------
Public Function GetLvValueIdx(ByRef lv As ListView, ByVal lngItemIdx As Long, ByVal strColKey As String) As String
    GetLvValueIdx = ""
    
    Dim intColIdx As Integer
    intColIdx = GetColIdx(lv, strColKey)
    
    If intColIdx = -1 Then
        MsgBox "[エラー]関数の指定が間違っています。関数名:GetLvValue"
        Exit Function
    End If
    
    If intColIdx = 1 Then
        GetLvValueIdx = lv.ListItems(lngItemIdx).Text
    Else
        GetLvValueIdx = lv.ListItems(lngItemIdx).SubItems(intColIdx - 1)
    End If
    
End Function

'----------------------------------------------------------------------------------------------------------
'関数:ListViewの指定項目の値を行Indexを指定して設定する
'----------------------------------------------------------------------------------------------------------
Public Sub SetLvValueIdx(ByRef lv As ListView, ByVal lngItemIdx As Long, ByVal strColKey As String, ByVal strValue As String)
    Dim intColIdx As Integer
    intColIdx = GetColIdx(lv, strColKey)
    
    If intColIdx = -1 Then
        MsgBox "[エラー]関数の指定が間違っています。関数名:SetLvValueIdx"
        Exit Sub
    End If
    
    If intColIdx = 1 Then
        lv.ListItems(lngItemIdx).Text = strValue
    Else
        lv.ListItems(lngItemIdx).SubItems(intColIdx - 1) = strValue
    End If
    
End Sub
'----------------------------------------------------------------------------------------------------------
'関数:ListViewの指定項目の値をListItemを指定して設定する
' 例: Dim item As ListItem
'       Set item = lvSample.ListItems.Add
'    Call SetLvValue(lvSample,item,"COL1_NAME","テスト 太郎")
'----------------------------------------------------------------------------------------------------------
Public Sub SetLvValue(ByRef lv As ListView, ByRef lvItem As ListItem, ByVal strColKey As String, ByVal strValue As String)
    Dim intColIdx As Integer
    intColIdx = GetColIdx(lv, strColKey)
    
    If intColIdx = -1 Then
        MsgBox "[エラー]関数の指定が間違っています。関数名:SetLvValue"
        Exit Sub
    End If
    
    If intColIdx = 1 Then
        lvItem.Text = strValue
    Else
        lvItem.SubItems(intColIdx - 1) = strValue
    End If
    
End Sub
'----------------------------------------------------------------------------------------------------------
'関数:列名からListViewの列Indexを取得する
'----------------------------------------------------------------------------------------------------------
Private Function GetColIdx(ByRef lv As ListView, ByVal strColKey As String) As Integer
    Dim i As Integer
    GetColIdx = -1
    For i = 1 To lv.ColumnHeaders.Count
        If lv.ColumnHeaders(i).Key = strColKey Then
            GetColIdx = i
            Exit Function
        End If
    Next
End Function
*****************************


0 件のコメント:

コメントを投稿

PowerShellでEdgeを自動化(インストール不要。参考:郵便追跡サービス自動操作)

1.経緯について  RPAのソフトをインストールできないので、これまでVBSでCreateObjectでブラウザの自動操作をすることがたまにあった。 ※いざというときの手札として持っているだけで安心感が段違い  見た目上IEがインストールされていなくても、CreateObject...