trying to scroll listbox with two commandbutton

[patricktoulon1]

hello i'me trying to scroll a listbox with a commandbutton but that dont work

Option Explicit

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

Private Const WM_VSCROLL = &H115
Const SB_LINEDOWN = 1
Const SB_LINEUP = 0

'event mouseUp for then button  because i need  a listbox focused

Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  ListBox1.SetFocus
   SendMessage ListBox1.[_GethWnd], WM_VSCROLL, SB_LINEUP, ByVal 0&

End Sub

Private Sub CommandButton2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  ListBox1.SetFocus
   SendMessage ListBox1.[_GethWnd], WM_VSCROLL, SB_LINEDOWN, ByVal 0&

End Sub

Private Sub UserForm_Activate()
ListBox1.List = Evaluate("row(1:30)")
End Sub

can you help me please

 

[patricktoulon1]

In my example, I have a control that can control the parent scroll

for example, here in the multipage 1 pages(0). Since there is no "BackColor" property in the multipage, I set a purple label in pages(0).
So when you enter it, it's fine, but if you're in the listbox and exit, the scroll of the multipage no longer works
so the mouse move event of the label restarts the scroll of the multipage

and all without giving focus to any control except for the textbox, since I'm using the curline method.

 

[Jaafar Tribak]

re
hello @Jaafar Tribak
i'me changing box ist's the same you
my files

Thanks for the file.

I have a couple of quick notes:

1- You have specific info in the Class module (such as cell addresses) . A Class well designed should never contain specific info . Specifics are meant to be determined by the Class client.

2- Your Class has only one Method "MouseWheel". Make sure all the other routines in the Class module are declared as Private

3- The Loop in the Class module never stops after closing the userform. You will need to fix this issue. Either by adding a new Method to explicitly close the userform or by slightly modifying the class code from within the loop in such a way that the loop detects if the userform is still loaded or already closed.

 

[patricktoulon1]

hello good evening @Jaafar Tribak

1°ok but it's just form démo
normally we delete these lines after

2° it's exact :it should be a private function

3° Normally, the loop stops when you leave the Control scope.
If it doesn't stop, it means the function determining the rectangle is malfunctioning.

4°normally the class instance is instantiated in the userform so when I close it it should be destroyed right?
Since the userform is a class module in its own right.

 

[Jaafar Tribak]

4°normally the class instance is instantiated in the userform so when I close it it should be destroyed right?
Since the userform is a class module in its own right.

If the loop is still running when the userform is being closed, the code continues executing.
Just place a Debug.Print Now inside the loop to see what I am talking about.

 

[patricktoulon1]

re
on my pc it's stop
.?????????????

and your model not working on Excel 2021 64 bit
we can see a counter of scrollines but the scroll it'snt effective

 

[Jaafar Tribak]

re
on my pc it's stop
.?????????????

The loop doesn't stop when I tried on excel2013 & xl2016 x32bit & x64bit

and your model not working on Excel 2021 64 bit
we can see a counter of scrollines but the scroll it'snt effective

I don't have excel 2021 so, I cannot test it.

 

[Jurassic Pork]

The loop doesn't stop when I tried on excel2013 & xl2016 x32bit & x64bit


I don't have excel 2021 so, I cannot test it.

Hello ,
it is me who has an issue with your code in Excel 2021 64 bits.
I have found a solution :

Private Function HiWord64(ByVal DWord As LongPtr) As Integer
        CopyMemory HiWord64, ByVal VarPtr(DWord) + 2&, 4&
End Function

Private Function LoWord64(ByVal DWord As LongPtr) As Integer
    CopyMemory LoWord64, DWord, 4&
End Function

Friendly, J.P

 

[patricktoulon1]

hello @Jaafar Tribak
You were right about the non-stop looping.
It was my test with ARX, which wasn't working well in the iscrollable function.

'Fonction qui control si le control est scrollable
Public Function IsScrollable(Ctrl As Object)
    Dim pos As POINTAPI, yyy&
    GetCursorPos pos
    On Error Resume Next
    If TypeOf Ctrl Is ComboBox Then DoEvents: yyy = (Ctrl.Font.Size * 1.2) * Ctrl.ListRows / Ppx
    On Error GoTo 0
     If IsArray(arx) Then
        If (pos.X > arx(1) And pos.Y > arx(2) And pos.X < arx(3) And pos.Y < arx(4) + yyy) Then
                DoEvents: IsScrollable = True
        Else
         IsScrollable = False
   [b1] = "Sortie" 'Ligne à supprimer
               End If
    End If
End Function

now it's work

 

[Jaafar Tribak]

Hello ,
it is me who has an issue with your code in Excel 2021 64 bits.
I have found a solution :

Private Function HiWord64(ByVal DWord As LongPtr) As Integer
        CopyMemory HiWord64, ByVal VarPtr(DWord) + 2&, 4&
End Function

Private Function LoWord64(ByVal DWord As LongPtr) As Integer
    CopyMemory LoWord64, DWord, 4&
End Function

Friendly, J.P

Thanks. Actually ,while the solution you provided did work, there is still an issue: it is not possible to copy 4 bytes into a variable that is only 2 bytes in size.

The correct functions for x64bits should look as follows:

Private Function HiWord64(ByVal DWord As LongPtr) As Integer
        CopyMemory HiWord64, ByVal VarPtr(DWord) + 2&, 2&
End Function

Private Function LoWord64(ByVal DWord As LongPtr) As Integer
    CopyMemory LoWord64, DWord, 2&
End Function

Obviously, before that, we would first need to replace this declaration:

#If Win64 Then
    Dim nDelta As Long, nVKey As Long
#Else
    Dim nDelta As Integer, nVKey As Integer
#End If

With this one:

Dim nDelta As Integer, nVKey As Integer

My initial confusion arose from the realization that, although 64bit systems employ 64bit pointers, many Windows messages, including WM_MOUSEWHEEL, continue to use the *first* 32 bits for wParam\lParam, primarily for backward compatibility. The remaining *last* 32 bits, in this case, are either unused or reserved.

So in conclusion, we can make this simpler by packing the two separate functions (x32 & x64) in one as follows:

Private Function HiWord(ByVal WParam As LongPtr) As Integer
        CopyMemory HiWord, ByVal VarPtr(WParam) + 2&, 2&
End Function

Private Function LoWord(ByVal WParam As LongPtr) As Integer
    CopyMemory LoWord, WParam, 2&
End Function

Or use bit shifting and masking w/o the use of CopyMemory as follows:

Private Function HiWord(ByVal WParam As LongPtr) As Integer
    HiWord = CInt((WParam \ &H10000) And &HFFFF)
End Function

Private Function LoWord(ByVal WParam As LongPtr) As Integer
    LoWord = CInt(WParam And &HFFFF)
End Function

I have updated the file example with the necessary corrections : ScrollTextBox_V1.xlsm

 

[Jaafar Tribak]

As we continue discussing scrollable multiline textboxes, I am curious whether there is a programmatic approach to hide the vertical scrollbar once it has been displayed.