I have a listbox which is filled at run-time and display the worksheets in
the workbook.
Because the number of sheets can be quite big, 50+, it is a much more
convenient way to navigate than using the sheets tab, normally at the bottom
of the excel window.
I have managed to get the Drag & Drop proc to work ok, I get the + symbol
when I drag, but how do I determine where the pointer is?
Or how do I get the entry that I am dragging to insert itself on mouse
release/up?
I have searched the internet for a few days now and the only solution I have
found is in VB.Net which is not good to me.
Thank you all in advance.

Doesn't the BeforeDropOrPaste event handler get passed the mouse pointer x
and y coordinates? I think you have to figure it out based on that.

--
Jim
"Phil" wrote in message
...
|I have a listbox which is filled at run-time and display the worksheets in
| the workbook.
| Because the number of sheets can be quite big, 50+, it is a much more
| convenient way to navigate than using the sheets tab, normally at the
bottom
| of the excel window.
| I have managed to get the Drag & Drop proc to work ok, I get the + symbol
| when I drag, but how do I determine where the pointer is?
| Or how do I get the entry that I am dragging to insert itself on mouse
| release/up?
| I have searched the internet for a few days now and the only solution I
have
| found is in VB.Net which is not good to me.
| Thank you all in advance.

Well yes there is! But how do figure out, based on mice coordinates, what's
under it.
How do I find what is the index of the ligne/item I want to move and drag to
that new position?

That's the rub mate.

"Jim Rech" wrote:

Doesn't the BeforeDropOrPaste event handler get passed the mouse pointer x
and y coordinates? I think you have to figure it out based on that.

--
Jim
"Phil" wrote in message
...
|I have a listbox which is filled at run-time and display the worksheets in
| the workbook.
| Because the number of sheets can be quite big, 50+, it is a much more
| convenient way to navigate than using the sheets tab, normally at the
bottom
| of the excel window.
| I have managed to get the Drag & Drop proc to work ok, I get the + symbol
| when I drag, but how do I determine where the pointer is?
| Or how do I get the entry that I am dragging to insert itself on mouse
| release/up?
| I have searched the internet for a few days now and the only solution I
have
| found is in VB.Net which is not good to me.
| Thank you all in advance.

Hi,
Maybe you should look into the ListView control which is available since win
2k to any user (installed with Windows).
This control is much more flexible that the regular Listbox:
- you can add icons to each row
- you can add column headers that respond to CLick events
- you can have your user resize the columns
- you can sort the list alphabetically based on a specific column
- (...)
- AND IT HAS A ITEM_CLICK event

To show this control in the Toolbox toolbar of the vba editor:
- add a reference to
Microsoft Windows Commom Controls 6.0 (SP4 or 6)
or browse to C:\Winnt\system32\mscomctl.ocx if the ref is not already in
the list
( or C:\Winnt\system32\mscomctl32.ocx if older version)
- right-click the Toolbox page name and add a new page
- on that new page, right click to add a control and add 'Microsoft Listview
Control' with the latest version.

Now add one ListView Control to a Userform and call it Lvw


''' #### Userform with 1 Listview control: Lvw
''' ############################################
Private Sub UserForm_Initialize()
With Lvw
.View = lvwReport ''' view as listbox
.AllowColumnReorder = False ''' prevent crashing xl sometimes

''' add columns and headers
.ColumnHeaders.Add 1, "h1", "Header1", 50
.ColumnHeaders.Add 2, "h2", "Header2", 50
.ColumnHeaders.Add 3, "h3", "Header3", 50

''' add row 1
With .ListItems.Add(1, "k11", "Item r1_c1")
.ListSubItems.Add 1, "k12", "Item r1_c2"
.ListSubItems.Add 2, "k13", "Item r1_c3"
End With
''' add row 2
With .ListItems.Add(2, "k21", "Item r2_c1")
.ListSubItems.Add 1, "k22", "Item r2_c2"
.ListSubItems.Add 2, "k23", "Item r2_c3"
End With

End With
End Sub

Private Sub Lvw_ItemClick(ByVal Item As MSComctlLib.ListItem)
MsgBox "Item " & Item.Index & " was clicked"
End Sub
''' ############################################

This may not be enough to track an item based on Mouse_down or Mouse_Up
event, so here is some new code that uses apis to track the item (column 1)
and subitems (columns 2,3,...) bellow the mouse pointer.
Clear the Userform module and paste the following code. It reacts to
mouse_down, but same idea for mouse_up.

''' ############################################
Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal lMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Private Const LVM_FIRST = &H1000
Private Const LVM_DELETEALLITEMS = (LVM_FIRST + 9)
Private Const LVM_GETITEMRECT = (LVM_FIRST + 14)
Private Const LVM_HITTEST = (LVM_FIRST + 18)
Private Const LVM_SUBITEMHITTEST = (LVM_FIRST + 57)
Private Const LVM_GETCOLUMNWIDTH = (LVM_FIRST + 29)
Private Const LVM_GETVIEWRECT = (LVM_FIRST + 34)
Private Const LVM_GETTOPINDEX = (LVM_FIRST + 39)
Private Const LVM_GETCOUNTPERPAGE = (LVM_FIRST + 40)
Private Const LVM_GETSUBITEMRECT = (LVM_FIRST + 56)

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Type LVHITTESTINFO
pt As POINTAPI
lFlags As Long
lItem As Long
lSubItem As Long
End Type

Private Sub UserForm_Initialize()
With Lvw
.View = lvwReport ''' view as listbox
.AllowColumnReorder = False ''' prevent crashing xl sometimes

''' add columns and headers
.ColumnHeaders.Add 1, "h1", "Header1", 50
.ColumnHeaders.Add 2, "h2", "Header2", 50
.ColumnHeaders.Add 3, "h3", "Header3", 50

''' add row 1
With .ListItems.Add(1, "k11", "Item r1_c1")
.ListSubItems.Add 1, "k12", "Item r1_c2"
.ListSubItems.Add 2, "k13", "Item r1_c3"
End With
''' add row 2
With .ListItems.Add(2, "k21", "Item r2_c1")
.ListSubItems.Add 1, "k22", "Item r2_c2"
.ListSubItems.Add 2, "k23", "Item r2_c3"
End With

End With
End Sub

Private Sub lvw_MouseDown(ByVal Button As Integer, ByVal Shift As Integer,
ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
Dim THT As LVHITTESTINFO
Dim LSI As ListSubItem
Dim LI As ListItem

HitTest X, Y, THT

If THT.lSubItem 0 And THT.lItem = 0 Then ''' SubItem Column
Set LI = Lvw.ListItems(THT.lItem + 1)
Set LSI = Lvw.ListItems(THT.lItem + 1).ListSubItems(THT.lSubItem)
MsgBox "List Item: " & LI.Index & " - List Subitem:" & LSI.Index
ElseIf THT.lSubItem = 0 And THT.lItem = 0 Then ''' ITEM column
Set LI = Lvw.ListItems(THT.lItem + 1)
Set LSI = Nothing
MsgBox "List Item: " & LI.Index & " - No Subitem clicked"
Else
MsgBox "No item clicked"
End If

End Sub

Private Sub HitTest(ByVal X As Single, ByVal Y As Single, tHitTest As
LVHITTESTINFO)
Dim lRet As Long
Dim lX As Long
Dim lY As Long

' x and y are in twips; convert them to pixels for the API call
lX = X '/ Screen.TwipsPerPixelX
lY = Y '/ Screen.TwipsPerPixelY

With tHitTest
.lFlags = 0
.lItem = 0
.lSubItem = 0
.pt.X = lX
.pt.Y = lY
End With

lRet = SendMessage(Lvw.hwnd, LVM_SUBITEMHITTEST, 0, tHitTest)
End Sub
''' ###########################################
--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Phil" wrote:

I have a listbox which is filled at run-time and display the worksheets in
the workbook.
Because the number of sheets can be quite big, 50+, it is a much more
convenient way to navigate than using the sheets tab, normally at the bottom
of the excel window.
I have managed to get the Drag & Drop proc to work ok, I get the + symbol
when I drag, but how do I determine where the pointer is?
Or how do I get the entry that I am dragging to insert itself on mouse
release/up?
I have searched the internet for a few days now and the only solution I have
found is in VB.Net which is not good to me.
Thank you all in advance.

Sebastien,

Thank ever so much for taking the time to help.

It is fantastique, I am going now to add the drag and drop bits, and we'll
see, I couldn'have done it without you.

Tahnks again.

Joseph

"sebastienm" wrote:

Hi,
Maybe you should look into the ListView control which is available since win
2k to any user (installed with Windows).
This control is much more flexible that the regular Listbox:
- you can add icons to each row
- you can add column headers that respond to CLick events
- you can have your user resize the columns
- you can sort the list alphabetically based on a specific column
- (...)
- AND IT HAS A ITEM_CLICK event

To show this control in the Toolbox toolbar of the vba editor:
- add a reference to
Microsoft Windows Commom Controls 6.0 (SP4 or 6)
or browse to C:\Winnt\system32\mscomctl.ocx if the ref is not already in
the list
( or C:\Winnt\system32\mscomctl32.ocx if older version)
- right-click the Toolbox page name and add a new page
- on that new page, right click to add a control and add 'Microsoft Listview
Control' with the latest version.

Now add one ListView Control to a Userform and call it Lvw


''' #### Userform with 1 Listview control: Lvw
''' ############################################
Private Sub UserForm_Initialize()
With Lvw
.View = lvwReport ''' view as listbox
.AllowColumnReorder = False ''' prevent crashing xl sometimes

''' add columns and headers
.ColumnHeaders.Add 1, "h1", "Header1", 50
.ColumnHeaders.Add 2, "h2", "Header2", 50
.ColumnHeaders.Add 3, "h3", "Header3", 50

''' add row 1
With .ListItems.Add(1, "k11", "Item r1_c1")
.ListSubItems.Add 1, "k12", "Item r1_c2"
.ListSubItems.Add 2, "k13", "Item r1_c3"
End With
''' add row 2
With .ListItems.Add(2, "k21", "Item r2_c1")
.ListSubItems.Add 1, "k22", "Item r2_c2"
.ListSubItems.Add 2, "k23", "Item r2_c3"
End With

End With
End Sub

Private Sub Lvw_ItemClick(ByVal Item As MSComctlLib.ListItem)
MsgBox "Item " & Item.Index & " was clicked"
End Sub
''' ############################################

This may not be enough to track an item based on Mouse_down or Mouse_Up
event, so here is some new code that uses apis to track the item (column 1)
and subitems (columns 2,3,...) bellow the mouse pointer.
Clear the Userform module and paste the following code. It reacts to
mouse_down, but same idea for mouse_up.

''' ############################################
Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal lMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Private Const LVM_FIRST = &H1000
Private Const LVM_DELETEALLITEMS = (LVM_FIRST + 9)
Private Const LVM_GETITEMRECT = (LVM_FIRST + 14)
Private Const LVM_HITTEST = (LVM_FIRST + 18)
Private Const LVM_SUBITEMHITTEST = (LVM_FIRST + 57)
Private Const LVM_GETCOLUMNWIDTH = (LVM_FIRST + 29)
Private Const LVM_GETVIEWRECT = (LVM_FIRST + 34)
Private Const LVM_GETTOPINDEX = (LVM_FIRST + 39)
Private Const LVM_GETCOUNTPERPAGE = (LVM_FIRST + 40)
Private Const LVM_GETSUBITEMRECT = (LVM_FIRST + 56)

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Type LVHITTESTINFO
pt As POINTAPI
lFlags As Long
lItem As Long
lSubItem As Long
End Type

Private Sub UserForm_Initialize()
With Lvw
.View = lvwReport ''' view as listbox
.AllowColumnReorder = False ''' prevent crashing xl sometimes

''' add columns and headers
.ColumnHeaders.Add 1, "h1", "Header1", 50
.ColumnHeaders.Add 2, "h2", "Header2", 50
.ColumnHeaders.Add 3, "h3", "Header3", 50

''' add row 1
With .ListItems.Add(1, "k11", "Item r1_c1")
.ListSubItems.Add 1, "k12", "Item r1_c2"
.ListSubItems.Add 2, "k13", "Item r1_c3"
End With
''' add row 2
With .ListItems.Add(2, "k21", "Item r2_c1")
.ListSubItems.Add 1, "k22", "Item r2_c2"
.ListSubItems.Add 2, "k23", "Item r2_c3"
End With

End With
End Sub

Private Sub lvw_MouseDown(ByVal Button As Integer, ByVal Shift As Integer,
ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
Dim THT As LVHITTESTINFO
Dim LSI As ListSubItem
Dim LI As ListItem

HitTest X, Y, THT

If THT.lSubItem 0 And THT.lItem = 0 Then ''' SubItem Column
Set LI = Lvw.ListItems(THT.lItem + 1)
Set LSI = Lvw.ListItems(THT.lItem + 1).ListSubItems(THT.lSubItem)
MsgBox "List Item: " & LI.Index & " - List Subitem:" & LSI.Index
ElseIf THT.lSubItem = 0 And THT.lItem = 0 Then ''' ITEM column
Set LI = Lvw.ListItems(THT.lItem + 1)
Set LSI = Nothing
MsgBox "List Item: " & LI.Index & " - No Subitem clicked"
Else
MsgBox "No item clicked"
End If

End Sub

Private Sub HitTest(ByVal X As Single, ByVal Y As Single, tHitTest As
LVHITTESTINFO)
Dim lRet As Long
Dim lX As Long
Dim lY As Long

' x and y are in twips; convert them to pixels for the API call
lX = X '/ Screen.TwipsPerPixelX
lY = Y '/ Screen.TwipsPerPixelY

With tHitTest
.lFlags = 0
.lItem = 0
.lSubItem = 0
.pt.X = lX
.pt.Y = lY
End With

lRet = SendMessage(Lvw.hwnd, LVM_SUBITEMHITTEST, 0, tHitTest)
End Sub
''' ###########################################
--
Regards,
Sébastien
<http://www.ondemandanalysis.com
<http://www.ready-reports.com


"Phil" wrote:

I have a listbox which is filled at run-time and display the worksheets in
the workbook.
Because the number of sheets can be quite big, 50+, it is a much more
convenient way to navigate than using the sheets tab, normally at the bottom
of the excel window.
I have managed to get the Drag & Drop proc to work ok, I get the + symbol
when I drag, but how do I determine where the pointer is?
Or how do I get the entry that I am dragging to insert itself on mouse
release/up?
I have searched the internet for a few days now and the only solution I have
found is in VB.Net which is not good to me.
Thank you all in advance.