ListViewコントロールドラッグドロップイベントの処理

はじめに。

ノードを再配置するMs-AccessのTreeViewControlでのドラッグアンドドロップ操作に精通しています。 Treeviewコントロールノードのすべての基本レコードは、単一のアクセステーブルから取得されます。ソースノードのParentIDは常に更新されます TreeViewコントロールの位置を変更するための、同じテーブルレコード上のターゲットノードのID値を持つフィールド値。レコードは物理的にどこにも移動されません。

ここでは、TreeViewControlとともにListViewControlを追加して、2つの異なるアクセステーブルを操作する予定です。

lvCategory –カテゴリコードと説明。
lvProducts –カテゴリごとの製品。

このようにして、両方のテーブル間の関係を理解しやすくなります。 TreeViewコントロールで1つの製品アイテム（ListViewアイテム）が1つのカテゴリから別のカテゴリに移動するときに、どのような変更を行う必要がありますか。

lvCategory アクセステーブルには、TreeViewノードと lvProductsの20のレコードがありますテーブルには、ListViewコントロール用に45があります。 Productsテーブルの1つ以上のレコードは、Categoryテーブルの製品カテゴリに直接関連しています。それらの間の関係は、製品テーブルの ParentID のカテゴリID（CID）フィールド値で更新されました製品のカテゴリの変更がListViewコントロールにすぐに反映されるようにフィールド。

デモデータテーブルは、Microsoft AccessサンプルデータベースNorthwind.accdbから取得され、2つの部分に分割されました。

lvProductレコードのParentIDフィールド値に基づいて、TreeViewコントロールでカテゴリノードが選択されたときに、ListViewコントロール内のすべての関連製品アイテムをフィルタリングして一覧表示できます。

これまでに取り上げたトピック。

TreeViewの主なトピックは次のとおりです。、 ImageList 、 ImageCombo、 およびListView コントロール、これまでMS-Accessで説明しました：

MicrosoftTreeViewControlチュートリアル
TreeViewコントロールを使用したアクセスメニューの作成
TreeViewコントロールへの画像の割り当て
TreeViewControl-2への画像の割り当て
TreeViewコントロールのチェックマーク-削除ノードの追加
TreeViewImageComboドロップダウンアクセスメニュー
ドラッグアンドドロップでTreeViewノードを再配置
MS-AccessTreeViewを使用したListViewコントロール

ListViewドラッグドロップタスク。

ListViewのドラッグアンドドロップ操作に関する限り、これはTreeViewコントロール内の同じメソッドのみを比較する簡単な演習です。ドラッグアンドドロップアクションにはTreeViewコントロールとListViewコントロールの両方が含まれるため、いくつかの単純なVBAコードで同じTreeView0_OLEDragDrop（）イベントプロシージャを使用します。

ListViewコントロールにリストされている製品アイテムは、TreeViewコントロールで選択されている現在のカテゴリアイテムに属しています。

ユーザーは、ListViewコントロールから特定の製品アイテムを選択し、それが別のカテゴリアイテムに属していると思われる場合は、TreeViewCcontrolのターゲットカテゴリアイテムにドラッグアンドドロップします。

移動したListView製品アイテムは、変更したカテゴリに属するアイテムのリストに追加されます。製品レコードのParentIDフィールド値は、ターゲットのカテゴリレコードID（CID値）で更新されます。

これは一方向のアクションであり、常にListViewアイテムをあるカテゴリから移動し、TreeViewコントロールの別のカテゴリノードにドロップします。

ListViewドラッグドロップデモアクセスフォームfrmListViewDrag’ ■試運転画面の画像を以下に示します。

上の画像では、飲料 TreeViewのカテゴリが選択されました。飲料カテゴリに属する製品は、ListViewコントロールにリストされています。

上記のフォームのデザインビュー：

フォームのコントロール名のリストは次のとおりです。

TreeViewコントロール： TreeView0
ListViewコントロール： ListView0
ImageListコントロール： ImageList3
コマンドボタン： cmdClose

frmListViewDragのVBAコードのクラスモジュール：

Option Compare Database
Option Explicit

Dim tv As MSComctlLib.TreeView
Dim lvList As MSComctlLib.ListView
Dim imgList As MSComctlLib.ImageList
Const Prfx As String = "X"

Private Sub Form_Load()
Dim db As DAO.Database
Dim tbldef As TableDef

    Set tv = Me.TreeView0.Object
    tv.Nodes.Clear
    
    Set imgList = Me.ImageList3.Object
    
With tv
    .Font.Size = 9
    .Font.Name = "Verdana"
    .ImageList = imgList 'assign preloaded imagelist control
 End With
    
    Set lvList = Me.ListView0.Object
    lvList.ColumnHeaders.Clear
    lvList.ListItems.Clear
    lvList.Icons = imgList
    
    Set db = CurrentDb
    Set tbldef = db.TableDefs("lvProducts")
    
    'Initialize ListView & Column Headers Property Values
     With lvList
        .ColumnHeaderIcons = imgList
        .Font.Size = 9
        .Font.Name = "Verdana"
        .Font.Bold = False
        
        'ColumnHeaders.Add() Syntax:
        'lvList.ColumnHeaders.Add Index, Key, Text, Width, Alignment, Icon
        'Alignment: 0 - Left, 1 - Right, 2 - Center
        .ColumnHeaders.Add 1, , tbldef.Fields(1).Name, 2600, 0, 5
        .ColumnHeaders.Add 2, , tbldef.Fields(3).Name, 2600, 0, 5
        .ColumnHeaders.Add 3, , tbldef.Fields(4).Name, 1440, 1, 5
    End With
    
    Set db = Nothing
    Set tbldef = Nothing

    
   LoadTreeView 'Create TreeView Nodes

End Sub

Private Sub LoadTreeView()
    Dim Nod As MSComctlLib.Node
    Dim firstCatID As Long
    Dim strCategory As String
    Dim strCatKey As String
    Dim strBelongsTo As String
    Dim strSQL As String
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    'Initialize treeview nodes
     tv.Nodes.Clear
     
    'Initialize Listview nodes
    While lvList.ListItems.Count > 0
          lvList.ListItems.Remove (1)
    Wend
    
    strSQL = "SELECT lvCategory.CID, lvCategory.Category, "
    strSQL = strSQL & "lvcategory.BelongsTo FROM lvCategory ORDER BY lvCategory.CID;"
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
    
    If Not rst.BOF And Not rst.EOF Then
        rst.MoveFirst
        firstCatID = rst!CID
    Else
        Exit Sub
    End If
    ' Populate all Records as Rootlevel Nodes
    Do While Not rst.BOF And Not rst.EOF
            strCatKey = Prfx & CStr(rst!CID)
            strCategory = rst!Category
            
            Set Nod = tv.Nodes.Add(, , strCatKey, strCategory, 1, 2)
            Nod.Tag = rst!CID
        rst.MoveNext
    Loop
    
    'In the second pass of the the same set of records
    'Move Child Nodes under their Parent Nodes
    rst.MoveFirst
    Do While Not rst.BOF And Not rst.EOF
        strBelongsTo = Nz(rst!BelongsTo, "")
        If Len(strBelongsTo) > 0 Then
            strCatKey = Prfx & CStr(rst!CID)
            strBelongsTo = Prfx & strBelongsTo
            strCategory = rst!Category
            
            Set tv.Nodes.Item(strCatKey).Parent = tv.Nodes.Item(strBelongsTo)
        End If
        rst.MoveNext
    Loop
    rst.Close
    
    ' Populate ListView Control with Product details
    ' of the first Category Item
    LoadListView firstCatID
    
End Sub


Private Sub LoadListView(ByVal CatID)
    Dim strProduct As String
    Dim strPKey As String
    Dim intcount As Integer
    Dim tmpLItem As MSComctlLib.ListItem
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    
    ' Initialize ListView Control
    While lvList.ListItems.Count > 0
        lvList.ListItems.Remove (1)
    Wend
   
     strSQL = "SELECT lvProducts.* FROM lvProducts "
     strSQL = strSQL & "WHERE (lvProducts.ParentID = " & CatID & ") "
     strSQL = strSQL & "ORDER BY lvProducts.[Product Name];"
    
    'Open filtered Products List for selected category
    Set db = CurrentDb
    Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
    
    Do While Not rst.BOF And Not rst.EOF
        intcount = intcount + 1
        strProduct = rst![Product Name]
        strPKey = Prfx & CStr(rst!PID)
        
        'List Item Add() Syntax:
        'lvList.ListItems.Add Index,Key,Text,Icon,SmallIcon
        Set tmpLItem = lvList.ListItems.Add(, strPKey, strProduct, , 3) 'first column
            lvList.ForeColor = vbBlue
            
            'List second column sub-item Syntax:
            'tmpLItem.ListSubItems.Add Column - Index, Key, Text, ReportIcon, ToolTipText
            tmpLItem.ListSubItems.Add 1, strPKey & CStr(intcount), Nz(rst![Quantity Per Unit], ""), 6
            
            'List third column sub-item
            tmpLItem.ListSubItems.Add 2, strPKey & CStr(intcount + 1), Format(rst![list Price], "0.00"), 6, "In Local Currency."
        rst.MoveNext
    Loop
    
    Set db = Nothing
    Set rst = Nothing
    
    If intcount > 0 Then lvList.ListItems(1).Selected = True
    
End Sub

Private Sub TreeView0_NodeClick(ByVal Node As Object)
Dim Cat_ID As String
Cat_ID = Node.Tag

LoadListView Cat_ID

End Sub

Private Sub TreeView0_OLEStartDrag(Data As Object, AllowedEffects As Long)
    Set tv.SelectedItem = Nothing
End Sub

Private Sub TreeView0_OLEDragOver(Data As Object, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
On Error GoTo TreeView0_OLEDragOver_Err

    Dim nodSelected As MSComctlLib.Node
    Dim nodOver As MSComctlLib.Node
    
    If tv.SelectedItem Is Nothing Then
        'Select a node if one is not selected
        Set nodSelected = tv.HitTest(X, Y)
        If Not nodSelected Is Nothing Then
            nodSelected.Selected = True
        End If
    Else
        If tv.HitTest(X, Y) Is Nothing Then
        'do nothing
        Else
            'Highlight the node the mouse is over
            Set nodOver = tv.HitTest(X, Y)
            Set tv.DropHighlight = nodOver
        End If
    End If
    
TreeView0_OLEDragOver_Exit:
Exit Sub

TreeView0_OLEDragOver_Err:
MsgBox Err & " : " & Err.Description, vbInformation, "TreeView0_OLEDragOver()"
Resume TreeView0_OLEDragOver_Exit
End Sub


Private Sub TreeView0_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)

    Dim tv_nodSource As Node
    Dim tv_nodTarget As Node
    
    Dim strtv_ParentKey As String
    Dim strtv_TargetKey As String
    Dim strListItemKey As String
    Dim strSQL As String
    
    Dim vCatID As Long
    Dim lngPID As Long
    
    On Error GoTo TreeView0_OLEDragDrop_Err
    
    'Get the source/destination Nodes
    Set tv_nodSource = tv.SelectedItem
    Set tv_nodTarget = tv.HitTest(X, Y)
    
        If Not tv_nodTarget Is Nothing Then
            strtv_ParentKey = tv_nodSource.Key
            strtv_TargetKey = tv_nodTarget.Key
                
            If strtv_ParentKey = strtv_TargetKey Then Exit Sub

            'Extract ListItem Key
            strListItemKey = lvList.SelectedItem.Key
                
            'extract Category Record CID Value
            'and ListItem Product ID Key
            vCatID = Val(Mid(tv_nodTarget.Key, 2))
            lngPID = Val(Mid(strListItemKey, 2))
    
            'UPDATE lvProducts Table
            strSQL = "UPDATE lvProducts SET ParentID = " & vCatID & _
            " WHERE PID = " & lngPID
             
            CurrentDb.Execute strSQL, dbFailOnError
                
            Set tv.DropHighlight = Nothing
            tv_nodSource.Selected = True
                
            'Rebuild ListView Nodes
            TreeView0_NodeClick tv_nodSource
                
        Else ' Invalid Target location
            MsgBox "The destination is invalid!", vbInformation
        End If
    
TreeView0_OLEDragDrop_Exit:
Exit Sub

TreeView0_OLEDragDrop_Err:
MsgBox Err & " : " & Err.Description, vbInformation, "TreeView0_OLEDragDrop()"
Resume TreeView0_OLEDragDrop_Exit
End Sub

Private Sub TreeView0_OLECompleteDrag(Effect As Long)
    Set tv.DropHighlight = Nothing
End Sub

Private Sub cmdClose_Click()
    DoCmd.Close
End Sub

おなじみのVBAコードセグメント。

Form_Load（） イベントプロシージャでは、TreeVew、ListView、ImageListコントロールを初期化します。 ColumnHeadingsを作成します ListViewコントロールにListアイテムを入力する前に、ListViewコントロールのこのルーチンの最後に、LoadTreeView（）サブルーチンを呼び出します。

LoadTreeView（） サブルーチンは、TreeViewコントロール上の製品のカテゴリノードに、 lvCategoryからのレコードを入力します。テーブル。 TreeViewコントロールへのノードのロードは2段階のプロセスです。一度に行うのではなく、なぜそうなのですか？この側面については、前のページの7番目のリンクで詳しく説明されていますあなたがそれを通過したいのであれば、上記のリンクのリストにあります。ここですべてを繰り返すのは適切でない場合があります。

上記のサブルーチンの最後に、 LoadListView（） サブルーチンは、最初のカテゴリレコードのCID値 1で呼び出されましたパラメータとして。

ParentIDフィールド値が1の製品レコードフィルタリングされ、ListViewコントロールにリストされています。この手順は、上記のリンクのリストの中で、先週の投稿である8番目の項目で詳細に説明されています。

ドラッグアンドドロップアクションのサブルーチン。

ドラッグアンドドロップアクションに関連する次のサブルーチンは、以下に示す順序で自動的に実行されます。

TreeView0_OLEStartDrag（）
TreeView0_OLEDragOver（）
TreeView0_OLEDragDrop（）
TreeView0_OLECompleteDrag（）

最初と最後のサブルーチンは、関係するノードを初期化し、最後にそれぞれのステータスをリセットします。

2番目のOLEDragOver（）サブルーチンは、MouseMoveイベントプロシージャのように機能し、ドラッグアンドドロップ操作中のマウスの動きを追跡します。マウスがノード上にあるときにNodeTextを強調表示し、マウスの左ボタンが離されるまでその軌跡を追跡します。

TreeView0_OLEDragDrop（）プロシージャコードのみを以下に示します。

Private Sub TreeView0_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)

    Dim tv_nodSource As Node
    Dim tv_nodTarget As Node
    
    Dim strtv_ParentKey As String
    Dim strtv_TargetKey As String
    Dim strListItemKey As String
    Dim strSQL As String
    
    Dim vCatID As Long
    Dim lngPID As Long
    
    On Error GoTo TreeView0_OLEDragDrop_Err
    
    'Get the source/destination Nodes
    Set tv_nodSource = tv.SelectedItem
    Set tv_nodTarget = tv.HitTest(X, Y)
    
        If Not tv_nodTarget Is Nothing Then
            strtv_ParentKey = tv_nodSource.Key
            strtv_TargetKey = tv_nodTarget.Key
                
            If strtv_ParentKey = strtv_TargetKey Then Exit Sub

            'Extract ListItem Key
            strListItemKey = lvList.SelectedItem.Key
                
            'extract Category Record CID Value
            'and ListItem Product ID Key
            vCatID = Val(Mid(tv_nodTarget.Key, 2))
            lngPID = Val(Mid(strListItemKey, 2))
    
            'UPDATE lvProducts Table
            strSQL = "UPDATE lvProducts SET ParentID = " & vCatID & _
            " WHERE PID = " & lngPID
             
            CurrentDb.Execute strSQL, dbFailOnError
                
            Set tv.DropHighlight = Nothing
            tv_nodSource.Selected = True
                
            'Rebuild ListView Nodes
            TreeView0_NodeClick tv_nodSource
                
        Else ' Invalid Target location
            MsgBox "The destination is invalid!", vbInformation
        End If
    
TreeView0_OLEDragDrop_Exit:
Exit Sub

TreeView0_OLEDragDrop_Err:
MsgBox Err & " : " & Err.Description, vbInformation, "TreeView0_OLEDragDrop()"
Resume TreeView0_OLEDragDrop_Exit
End Sub

ドラッグアンドドロップアクションのステップバイステップ。

TreeView0_OLEDragDrop（）プロシージャは、マウスの左ボタンを離した直後に実行され、ドロップアクションが完了します。コードの先頭で、アクティブおよびターゲットTreeViewノードの参照が tv_nodSourceに保存されています。およびtv_nodTarget それぞれオブジェクト変数。

次に、ListItemが有効なTreeViewノードにドロップされているかどうかのチェックを実行します。同じソースカテゴリノードまたはTreeViewコントロールの空の領域にドロップされた場合、これらの移動は無効です。 TreeViewコントロールの空の領域にドロップされた場合は、 tv_nodTarget オブジェクト変数には、値Nothingが含まれます。 その場合はメッセージを表示し、プログラムを終了します。

次に、TreeViewのソースとターゲットノードのキー値が2つの文字列変数に保存されます。両方のキーが同じである場合、ListItemはTreeViewコントロールの独自の親ノード（カテゴリノード）にドラッグアンドドロップされます。プログラムの実行は中止され、それ以上進むことはできません。

両方のキーが異なる場合は、製品レコードの ParentIDの変更を更新します。フィールド、ターゲットカテゴリレコードの CID ListViewアイテムをコーディングして更新します。

選択したListItemのキー値（ PID フィールド値）が strListItemKeyに保存されました文字列変数。

カテゴリレコードの実際のCID フィールド値は、プレフィックス文字値Xを削除してターゲットノードから抽出され、変数 vCatIDに保存されています。。これは、ListItemを新しいカテゴリの下に配置するために、ProductRecordのParentIDフィールドで更新する値です。

同様に、選択したリストアイテムの商品のキーPID値が抽出され、変数 lngPIDに保存されます。これは、ParentIDフィールドを vCatID で更新するために、その特定の製品レコードをフィルタリングおよび選択するための基準として使用されています。。

更新 lngPID を使用して、レコードをフィルタリングするクエリSQLが作成されました基準としてコーディングし、製品レコードをフィルタリングし、 vCatIDを更新します Pの値 arentID フィールド。

実行 Currentdbのメソッド SQLで呼び出され、変更を更新します。

ノードのハイライトがソースノードにリセットされました。

次に、TreeView0_NodeClick（）サブルーチンが tv_nodSourceで呼び出されました。 ListViewコントロールの変更を反映するパラメータとして。

閉じる ボタンをクリックするとフォームが閉じます。

デモデータベースをダウンロードします。

デモデータベースをダウンロードし、試運転を行い、VBAコードを調べることができます。

新年あけましておめでとうございます。

MS-Accessイベントの処理

WitheventsMS-Accessクラスモジュール
イベントありと独自のイベントの定義
Witheventsコンボリストの[テキストボックス]タブ
アクセスフォームコントロールの配列とイベント
アクセスフォームコントロールアレイとイベント-2
アクセスフォームコントロールアレイとイベント-3
サブフォームのクラスモジュールのイベントあり
クラスモジュールとデータのイベントあり
イベントとアクセスレポートのイベントシンク
イベントとレポート行の非表示
イベントとレポート行の強調表示
イベントTexboxとコマンドボタン付き
Witheventsテキストボックスコマンドボタン
イベントとすべてのフォームコントロールタイプ