listbox On Userform

[Sharid]

I have a listbox on a userform, as data goes into the sheet the listbox is updated, I have two issues

1) Listbox scroll moves to the TOP every time data goes into it
2) I have 12 columns showing in the list box, which give it a horizontal scroll bar, however 12 columns are not always used, is there a way to hide the bottom scroll bar and only show if last column is being updated is populated with data.

 

[Jaafar Tribak]

For the first question, you can do something along these lines :

ListBox1.ListIndex = ListBox1.ListCount - 1

For the second question, there is now way to hide that scrollbar AFAIK, unless you dynamically make the listbox width bigger or the individual columnwidths smaller or place a label or something over it.... clumsy workaround, but relatively painless.

The MSForms listbox scrollbars (specially the horizontal one) are not propper scrollbars with a hwnd nor are they exposed via MSAA or UIAutomation so there is little one can do to programmatically handle them.

Te only remaining thing that I can think of is to remove the scrollbar area from the clipping region but, that will involve some coding.

Looks like a good learning exercise and i'll try to give it a go.

 

[Jaafar Tribak]

Try this :

ToggleListboxScrollBars.xls





1- API code in a Standard Module

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare PtrSafe Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPtr
    Private Declare PtrSafe Function CombineRgn Lib "gdi32" (ByVal hDestRgn As LongPtr, ByVal hSrcRgn1 As LongPtr, ByVal hSrcRgn2 As LongPtr, ByVal nCombineMode As Long) As Long
    Private Declare PtrSafe Function SetWindowRgn Lib "user32" (ByVal hwnd As LongPtr, ByVal hRgn As LongPtr, ByVal bRedraw As Long) As Long
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
#End If


Public Sub ShowScrollBars(ByVal IlistBox As Control, Optional ByVal Horiz As Boolean = True, Optional ByVal Vert As Boolean = True)

    #If Win64 Then
        Dim hwnd As LongLong, hCipRgn As LongLong, hRngHoriz As LongLong, hRgnVert As LongLong
    #Else
        Dim hwnd As Long, hCipRgn As Long, hRngHoriz As Long, hRgnVert As Long
    #End If
    
    Const SM_CXVSCROLL = 2
    Const SM_CYHSCROLL = 3
    Const RGN_AND = 1
    
    Dim lHoriztScrollHeight As Long
    Dim lVertScrollWidth As Long
    Dim tClientRect As RECT    
    
    hwnd = IlistBox.[_GethWnd]
    lVertScrollWidth = GetSystemMetrics(SM_CXVSCROLL)
    lHoriztScrollHeight = GetSystemMetrics(SM_CYHSCROLL)
    
    With tClientRect
        Call GetClientRect(hwnd, tClientRect)
        hCipRgn = CreateRectRgn(.Left, .Top, .Right, .Bottom)
        Call SetRect(tClientRect, .Left, .Top, .Right, .Bottom - lHoriztScrollHeight)
        hRngHoriz = CreateRectRgn(.Left, .Top, .Right, .Bottom)
        Call GetClientRect(hwnd, tClientRect)
        Call SetRect(tClientRect, .Left, .Top, .Right - lVertScrollWidth, .Bottom)
        hRgnVert = CreateRectRgn(.Left, .Top, .Right, .Bottom)
    End With
    
    If Horiz = False Then
        Call CombineRgn(hCipRgn, hCipRgn, hRngHoriz, RGN_AND)
    End If
    If Vert = False Then
        Call CombineRgn(hCipRgn, hCipRgn, hRgnVert, RGN_AND)
    End If
    
    Call SetWindowRgn(hwnd, hCipRgn, True)
    IlistBox.Parent.Repaint
    
    Call DeleteObject(hCipRgn)
    Call DeleteObject(hRngHoriz)
    Call DeleteObject(hRgnVert)

End Sub

2- Code Usage as per the file above demo (In the UserForm Module)

Option Explicit


Private Sub ToggleButtonBoth_Click()
    With ToggleButtonBoth
        ShowScrollBars UserForm1.ListBox1, Not .Value, Not .Value
    End With
End Sub

Private Sub ToggleButtonVert_Click()
    With ToggleButtonVert
        ShowScrollBars UserForm1.ListBox1, True, Not .Value
    End With
End Sub

Private Sub ToggleButtonHoriz_Click()
    With ToggleButtonHoriz
        ShowScrollBars UserForm1.ListBox1, Not .Value, True
    End With
End Sub

In your particular scenario for only hiding the bottom horizontal scrollbar , you want this :

ShowScrollBars UserForm1.ListBox1, False

 

[Sharid]

As always super stuff

 

[Jaafar Tribak]

I just discovered that te above code will only work if applied to a single ListBox (the one with the focus) .... Below, is a little update should there be a need for hiding\showing the scrollbars of multiple ListBoxes at once.

ToggleListboxScrollBars.xls Update

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare PtrSafe Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPtr
    Private Declare PtrSafe Function CombineRgn Lib "gdi32" (ByVal hDestRgn As LongPtr, ByVal hSrcRgn1 As LongPtr, ByVal hSrcRgn2 As LongPtr, ByVal nCombineMode As Long) As Long
    Private Declare PtrSafe Function SetWindowRgn Lib "user32" (ByVal hwnd As LongPtr, ByVal hRgn As LongPtr, ByVal bRedraw As Long) As Long
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
#End If


Public Sub ShowScrollBars(ByVal ListBox As Control, Optional ByVal Horiz As Boolean = True, Optional ByVal Vert As Boolean = True)

    #If Win64 Then
        Dim hwnd As LongLong, hCipRgn As LongLong, hRngHoriz As LongLong, hRgnVert As LongLong
    #Else
        Dim hwnd As Long, hCipRgn As Long, hRngHoriz As Long, hRgnVert As Long
    #End If
   
    Const SM_CXVSCROLL = 2
    Const SM_CYHSCROLL = 3
    Const RGN_AND = 1
   
    Dim lHoriztScrollHeight As Long
    Dim lVertScrollWidth As Long
    Dim tClientRect As RECT
    Dim oActiveCtrl As Control  
   
    Set oActiveCtrl = ListBox.Parent.ActiveControl
    If ListBox.Enabled Then ListBox.SetFocus
   
    hwnd = ListBox.[_GethWnd]
   
    lVertScrollWidth = GetSystemMetrics(SM_CXVSCROLL)
    lHoriztScrollHeight = GetSystemMetrics(SM_CYHSCROLL)
   
    With tClientRect
        Call GetClientRect(hwnd, tClientRect)
        hCipRgn = CreateRectRgn(.Left, .Top, .Right, .Bottom)
        Call SetRect(tClientRect, .Left, .Top, .Right, .Bottom - lHoriztScrollHeight)
        hRngHoriz = CreateRectRgn(.Left, .Top, .Right, .Bottom)
        Call GetClientRect(hwnd, tClientRect)
        Call SetRect(tClientRect, .Left, .Top, .Right - lVertScrollWidth, .Bottom)
        hRgnVert = CreateRectRgn(.Left, .Top, .Right, .Bottom)
    End With
   
    If Horiz = False Then
        Call CombineRgn(hCipRgn, hCipRgn, hRngHoriz, RGN_AND)
    End If
    If Vert = False Then
        Call CombineRgn(hCipRgn, hCipRgn, hRgnVert, RGN_AND)
    End If
   
    Call SetWindowRgn(hwnd, hCipRgn, True)
   
    ListBox.Parent.Repaint
    oActiveCtrl.SetFocus
   
    Call DeleteObject(hCipRgn)
    Call DeleteObject(hRngHoriz)
    Call DeleteObject(hRgnVert)

End Sub