VBA从TreeView拖放到ListView&ListView到TreeView(ActiveX控件) [英] VBA Drag Drop From TreeView to ListView & ListView to TreeView (ActiveX Controls)
问题描述
仅尝试将子节点从ActiveX TreeView控件拖动到VBA for Excel中的ActiveX ListView控件.它偶尔会起作用，但是出了点问题.我无法持续触发拖动事件(有时可以正常工作，有时不能正常工作)，或者无法确定要添加到列表中的内容.
Trying to drag a child node only from a ActiveX TreeView Control to an ActiveX ListView control in VBA for Excel. It works occasionally, but something is wrong. I'm unable to consistently get the drag event to fire (sometimes it works, sometimes not) or, when it does, determine what was selected to add to the listivew.
我的TreeView具有以下节点
My TreeView has the following nodes
-US (tag='parent')
-West (tag='parent')
-CA (tag='child')
-WA (tag='child')
-East (tag='parent')
-NY (tag='child')
-FL (tag='child')
在上面，我只希望拖动对标记为子"的节点起作用.我尝试的代码如下:
In the above, I only want the drag to work on the nodes taged as 'child'. My attempted code is as follows:
Dim MyTreeNode As Node
Dim MyText As String
Private Sub TreeView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
Dim MyDataObject As DataObject
Dim Effect As Integer
If Button = 1 Then
'For some reason this executes multple times even though I'm only picking one node.
Debug.Print TreeView1.SelectedItem.Text
If InStr(1, TreeView1.SelectedItem.Tag, "Child") > 0 Then
Set MyTreeNode = TreeView1.SelectedItem
Set MyDataObject = New DataObject
MyText = TreeView1.SelectedItem.Text
MyDataObject.SetText MyText
Effect = MyDataObject.StartDrag
End If
End If
End Sub
Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MyListViewItem As ListItem
Set MyListViewItem = ListView1.ListItems.Add(1, "M" & MyTreeNode.Key, MyTreeNode.Text)
End Sub
也尝试反向执行此操作，但从TreeView到ListView开始
Also trying to do this in reverse as well, but starting with TreeView to ListView
推荐答案
哇！经过几天的玩耍和研究，我能够自己找到答案.这是给其他可能遇到相同问题的人的.
Whew! After a few days of playing around and research I was able to find the answer on my own. Here it is for others who may have the same problem.
首先，一些重要说明:
1).您必须为TreeView和ListView设置以下OLE属性.
TreeView1.OLEDragMode = 1 'Automatic
ListView1.OLEDropMode = 1 'Manual
2).为了从TreeView确定选定的节点，必须在MouseDown事件期间使用HitTest方法.
这在很大程度上导致了我的问题，因为我永远无法获得它来给我正确的选定节点，然后才知道要添加到ListView的数据.
This was causing a large part of my problem because I couldn't ever get it to give me the right selected node to then know what data to add to my ListView.
要确定选定的节点，请使用TreeView.SelectedItem属性.奇怪的是，除非您在MouseDown事件中进行设置，否则VB始终会认为您先前选择的项目是当前选定的项目，并将错误的数据添加到ListView.为什么?
To determine the selected node you use the TreeView.SelectedItem property. The quirky thing with that though is that unless you set it during the MouseDown event, VB will always think the previously item you selected item is the current selected item and add the wrong data to the ListView. Why?
TreeView.SelectedItem是在MouseUp事件上确定的.例如，如果完全单击鼠标并在节点1"上释放鼠标，则将触发MouseDown和MouseUp事件，而MouseUp事件会将TreeView.SelectedItem设置为节点1".然后，如果您单击并按住节点2"上的鼠标按钮，然后立即开始拖动(不释放鼠标按钮)，则仅触发MouseDown事件.由于MouseUp事件从不触发，因此即使拖动节点2"，TreeView.SelectedItem属性仍保持为节点1".因此，当您稍后尝试使用SelectedItem属性来确定要添加到目标ListView的内容时(以我为例)，它将得到错误的数据.
The TreeView.SelectedItem is determined on the MouseUp event. If, for example, you do a full mouse click and release on "Node 1", both the MouseDown and MouseUp events fire and the MouseUp event will set the TreeView.SelectedItem to "Node 1". Then, if you down click and HOLD the mouse button on "Node 2" and then immediately begin dragging (without releasing the mouse button), only the MouseDown event triggers. Since the MouseUp event never triggers, the TreeView.SelectedItem property stays as "Node 1" even though you are dragging "Node 2". Therefore, when you try to use the SelectedItem property later to determine what to add to the target ListView (in my case) it gets the wrong data.
3).在MouseDown事件期间使用HitTest方法时，必须将Pixels转换为TWIPS.
MouseDown方法以像素为单位返回x-y坐标，但是，在VBA中，HitTest方法使用TWIPS(显然.NET现在使用像素，因此无需在那里进行转换).因此，为了确定正确的节点，您必须对其进行转换.我对几乎所有Windows计算机的阅读比例都是15:1，所以您可以简单地使用以下内容:
The MouseDown method returns the x-y coordinates in pixels, however, in VBA the HitTest method uses TWIPS (apparently .NET which now uses pixels so no conversion is needed there). So in order to determine the correct node, you have to convert it. I've read most to almost all Windows computers have a 15 to 1 ratio so you can simply use the following:
Set TreeView1.SelectedItem = TreeView1.HitTest(x * 15, y * 15)
但是，如果您不希望15:1的比例适用于所有Windows计算机，则可以使用下面将演示的Windows API调用进行计算.
However, if you don't want to take the chance that the 15 to 1 ratio will work for all Windows computers, you can calculate it using Windows API calls which I demonstrate below.
这是简化的代码版本.
请注意，我通过使用自动"拖动属性和设置来保持简单，因此我不必使用"DataObject"方法来设置光标，确定拖动效果等...我只需使用默认值并保持简单即可.
Note I'm keeping it simple by using the 'Automatic' drag property and settings so I don't have to use the 'DataObject' methods to set the cursor, determine the drag effects, etc... I'm just using the defaults and keeping it simple.
Private Sub TreeView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
Set TreeView1.SelectedItem = Nothing
If TreeView1.SelectedItem Is Nothing Then
Set TreeView1.SelectedItem = TreeView1.HitTest(x * 15, y * 15)
End If
End Sub
Private Sub TreeView1_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
Data.SetData TreeView1.SelectedItem.Text, 1
End Sub
Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
ListView1.ListItems.Add ListView1.ListItems.Count + 1, , Data.GetData(1)
End Sub
就是这样！
您应该可以从那里使用它来添加所需的任何其他功能.下面，我给出了另外两个选择.
You should be able to take it from there to add any additional features you want. Below, I've given a couple more alternatives.
替代方法1-突出显示效果
可以使用另一种方法为用户提供视觉效果，使其在选择之前突出显示树节点.(注意:您也可以在TreeView OLEDragOver事件期间执行此操作，但是我正在使用MouseMove事件)
An alternative approach could be used to give the visual to the user that highlights the tree node before selecting. (Note: You could do this during the TreeView OLEDragOver event as well, but I'm using the MouseMove Event)
Private Sub TreeView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
If Not (TreeView1.HitTest(x * TwipsPerPixelX, y * TwipsPerPixelY) Is Nothing) Then
Dim MyNode As Node
Set MyNode = TreeView1.HitTest(x * 15, y * 15)
MyNode.Selected = True
Set MyNode = Nothing
End If
End Sub
Private Sub TreeView1_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
Data.SetData TreeView1.SelectedItem.Text, 1
End Sub
Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
ListView1.ListItems.Add ListView1.ListItems.Count + 1, , Data.GetData(1)
End Sub
替代2-计算像素到TWIPS的转换
请记住，这仅在VBA中需要.您不需要在.NET中执行此操作，因为我相信它在Event和HitTest方法中都使用像素.
Remember, this is only needed in VBA. You don't need to do this in .NET because I believe it uses pixels in both the Events and the HitTest methods.
没有像上面那样明确地将转换表示为15:
Instead of explicitly stating the conversion as 15 as in the above:
Set MyNode = TreeView1.HitTest(x * 15, y * 15)
您可以结合使用Windows API调用和您自己的函数进行计算.就是这样.
You could calculate it using a combination of Windows API calls and your own function. Here's how.
首先，将Windows API调用和用户定义的函数放置在Module1中:
First, the Windows API calls and user defined function placed in Module1:
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Public Function TwipsPerPixelX() As Integer
Dim MyDesktopWindowHandle As Long, MyDesktopWindowDeviceContext As Long
Dim MyWidthOfScreen As Long, MyUsedToReleaseDeviceContext As Long
'Get the handle of the desktop window
MyDesktopWindowHandle = GetDesktopWindow()
'Get the desktop window's device context
MyDesktopWindowDeviceContext = GetDC(MyDesktopWindowHandle)
'Get the width of the screen
MyWidthOfScreen = GetDeviceCaps(MyDesktopWindowDeviceContext, LOGPIXELSX)
'Release the device context
MyUsedToReleaseDeviceContext = ReleaseDC(MyDesktopWindowHandle, MyDesktopWindowDeviceContext)
TwipsPerPixelX = 1440 / MyWidthOfScreen '1 inch is always 1440 twips
End Function
Public Function TwipsPerPixelY() As Integer
Dim MyDesktopWindowHandle As Long, MyDesktopWindowDeviceContext As Long
Dim MyHeightOfScreen As Long, MyUsedToReleaseDeviceContext As Long
'Get the handle of the desktop window
MyDesktopWindowHandle = GetDesktopWindow()
'Get the desktop window's device context
MyDesktopWindowDeviceContext = GetDC(MyDesktopWindowHandle)
'Get the width of the screen
MyHeightOfScreen = GetDeviceCaps(MyDesktopWindowDeviceContext, LOGPIXELSY)
'Release the device context
MyUsedToReleaseDeviceContext = ReleaseDC(MyDesktopWindowHandle, MyDesktopWindowDeviceContext)
TwipsPerPixelY = 1440 / MyHeightOfScreen '1 inch is always 1440 twips
End Function
然后将代码的HitTest部分更改为以下内容:
Then change the HitTest part of the code to the following:
Set TreeView1.SelectedItem = TreeView1.HitTest(x * TwipsPerPixelX, y * TwipsPerPixelY)
希望有帮助！
参考文献:
以下是有助于将其组合在一起的参考资料，我必须在应归功的地方予以表扬.
Here are the references that helped piece this together and I must give credit where credit is due.
http://vbcity.com/forums/t/49091.aspx
http://www.experts-exchange.com/questions/20497792/TwipsPerPixelX-Y-via-the-API-for-VBA.html
这篇关于VBA从TreeView拖放到ListView&ListView到TreeView(ActiveX控件)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
