ListBox di chuyển Scroll theo item được lựa chọn

An.BA · 13/1/20

Em có tạo 1 List Box từ Form Controls.
Khi em bấm next thì item nó có chạy mã tiếp theo nhưng cái Scroll kia nó không nhảy theo ạ.
Vậy làm thế nào để nó di chuyển theo cái item đang được lựa chọn ạ.
Em cảm ơn ạ.


Sub btnSau()
On Error GoTo loi
        i = Sheet4.Shapes("List Box 7").ControlFormat.ListIndex + 1
        Sheet4.Shapes("List Box 7").ControlFormat.ListIndex = Sheet4.Shapes("List Box 7").ControlFormat.ListIndex + 1
loi:
End Sub

Hoàng Trọng Nghĩa · 13/1/20

An.BA đã viết:
Em có tạo 1 List Box từ Form Controls.
Khi em bấm next thì item nó có chạy mã tiếp theo nhưng cái Scroll kia nó không nhảy theo ạ.
Vậy làm thế nào để nó di chuyển theo cái item đang được lựa chọn ạ.
Em cảm ơn ạ.
Sub btnSau() On Error GoTo loi i = Sheet4.Shapes("List Box 7").ControlFormat.ListIndex + 1 Sheet4.Shapes("List Box 7").ControlFormat.ListIndex = Sheet4.Shapes("List Box 7").ControlFormat.ListIndex + 1 loi: End Sub
View attachment 231121

NÚT TỚI:

Mã:

Private Sub cmdNext_Click()
    With ListBox1
        Dim lngIndex As Long, lngListCount As Long
        lngListCount = .ListCount - 1
        lngIndex = .ListIndex + 1
        .ListIndex = WorksheetFunction.Min(lngListCount, lngIndex)
    End With
End Sub

NÚT LÙI:

Mã:

Private Sub cmdPrevious_Click()
    With ListBox1
        Dim lngIndex As Long
        lngIndex = .ListIndex - 1
        .ListIndex = WorksheetFunction.Max(lngIndex, 0)
    End With
End Sub

An.BA · 13/1/20

Hoàng Trọng Nghĩa đã viết:

NÚT TỚI:

Mã:

Private Sub cmdNext_Click()
    With ListBox1
        If .ListIndex = -1 Then
            .ListIndex = 0
        Else
            Dim lngIndex As Long, lngListCount As Long
            lngListCount = .ListCount - 1
            lngIndex = .ListIndex + 1
            If lngIndex > lngListCount Then Exit Sub
            .ListIndex = lngIndex
        End If
    End With
End Sub

NÚT LÙI:

Mã:

Private Sub cmdPrevious_Click()
    With ListBox1
        If .ListIndex = -1 Then
            .ListIndex = 0
        Else
            Dim lngIndex As Long
            lngIndex = .ListIndex - 1
            .ListIndex = WorksheetFunction.Max(lngIndex, 0)
        End If
    End With
End Sub

Nó báo lỗi như này ạ
Run-time error '424'
Object required
Anh xem lại giúp em với ạ,

Hoàng Trọng Nghĩa · 13/1/20

An.BA đã viết:
Nó báo lỗi như này ạ
Run-time error '424'
Object required
Anh xem lại giúp em với ạ,

Tôi đặt tên theo cách mà tôi nghĩ thôi, còn bạn phải sửa lại tên các ListBox hay CommandButton chứ?
Nếu không thì bạn phải gửi cái file lên tôi xem.

An.BA · 13/1/20

Hoàng Trọng Nghĩa đã viết:
Tôi đặt tên theo cách mà tôi nghĩ thôi, còn bạn phải sửa lại tên các ListBox hay CommandButton chứ?
Nếu không thì bạn phải gửi cái file lên tôi xem.

Đây ạ, em chỉ sửa nó thành List box 7 thôi ạ
Còn button thì em add đúng code đó vào rồi ạ

ndu96081631 · 13/1/20

Hoàng Trọng Nghĩa đã viết:

NÚT TỚI:

Mã:

Private Sub cmdNext_Click()
    With ListBox1
        Dim lngIndex As Long, lngListCount As Long
        lngListCount = .ListCount - 1
        lngIndex = .ListIndex + 1
        .ListIndex = WorksheetFunction.Min(lngListCount, lngIndex)
    End With
End Sub

NÚT LÙI:

Mã:

Private Sub cmdPrevious_Click()
    With ListBox1
        Dim lngIndex As Long
        lngIndex = .ListIndex - 1
        .ListIndex = WorksheetFunction.Max(lngIndex, 0)
    End With
End Sub

ListBox FORM CONTROLS nha Nghĩa

An.BA · 13/1/20

Dạ em gửi kèm file đây ạ

ndu96081631 · 13/1/20

An.BA đã viết:
Dạ em gửi kèm file đây ạ

Code đó là viết cho ListBox ActiveX Controls, không dùng được cho trường hợp của bạn đâu
Với ListBox Form Controls, để có thể scroll bằng code, tôi nghĩ rất khó (ít nhất là đối với tôi).
Nếu ai đó làm được và giải pháp không quá phức tạp, tôi cũng rất muốn học hỏi.

leonguyenz · 13/1/20

An.BA đã viết:
Dạ em gửi kèm file đây ạ

Dùng code bài #4 của anh @Hoàng Trọng Nghĩa

Mã:

    With Sheet4.Shapes("List Box 7").ControlFormat
        Dim lngIndex As Long
        lngIndex = .ListIndex - 1
        .ListIndex = WorksheetFunction.Max(lngIndex, 0)
    End With

Tương tự nút tiến tới.

An.BA · 13/1/20

leonguyenz đã viết:
Dùng code bài #4 của anh @Hoàng Trọng Nghĩa

Mã:

With Sheet4.Shapes("List Box 7").ControlFormat Dim lngIndex As Long lngIndex = .ListIndex - 1 .ListIndex = WorksheetFunction.Max(lngIndex, 0) End With

Tương tự nút tiến tới.

Cái scroll nó không nhảy anh ạ

leonguyenz · 13/1/20

An.BA đã viết:
Cái scroll nó không nhảy anh ạ

Dzụ Scroll nhảy theo ListBox thì khó.
Tham khảo bài này thử.

Hoàng Trọng Nghĩa · 13/1/20

An.BA đã viết:
Cái scroll nó không nhảy anh ạ

Mã:

Sub btnTruoc()
    With Sheet4.Shapes("List Box 7").ControlFormat
        Dim lngIndex As Long
        lngIndex = .ListIndex - 1
        .ListIndex = WorksheetFunction.Max(lngIndex, 1)
    End With
End Sub

Sub btnSau()
    With Sheet4.Shapes("List Box 7").ControlFormat
        Dim lngIndex As Long
        lngIndex = .ListIndex + 1
        .ListIndex = WorksheetFunction.Min(.ListCount, lngIndex)
    End With
End Sub

Kiều Mạnh · 13/1/20

ndu96081631 đã viết:
ListBox FORM CONTROLS nha Nghĩa

Nếu em nhớ ko lộn thì em có file vb6 như thế... chiều hay mai rảnh em coi lại úp cho

Kiều Mạnh · 13/1/20

Anh @ndu96081631 ,@Hoàng Trọng Nghĩa
Thử xem sao nhé ... thấy code nó đơn giản lắm không biết đúng không nữa
Code trên Form

Mã:

Private Sub Command1_Click(Index As Integer)
    On Error Resume Next
    Select Case Index
    Case 0
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_LINEUP, 0
    Case 1
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_LINEDOWN, 0
    Case 2
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_TOP, 0
    Case 3
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_BOTTOM, 0
    Case 4
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_PAGEUP, 0
    Case 5
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_PAGEDOWN, 0
    Case Else: Exit Sub
    End Select
End Sub

Private Sub Form_Load()
    On Error Resume Next
    Call PopulateList
End Sub

Code trong Module

Mã:

Public Declare Function SendMessageByLong Lib "user32" Alias "SendMessageA" _
          (ByVal hwnd As Long, _
          ByVal wMsg As Long, _
          ByVal wParam As Long, _
          ByVal lParam As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" _
          (ByVal nIndex As Long) As Long
Public Const WM_VSCROLL = &H115
Public Const SB_LINEUP = 0
Public Const SB_LINEDOWN = 1
Public Const SB_PAGEUP = 2
Public Const SB_PAGEDOWN = 3
Public Const SB_THUMBPOSITION = 4
Public Const SB_THUMBTRACK = 5
Public Const SB_TOP = 6
Public Const SB_BOTTOM = 7
Public Const SB_ENDSCROLL = 8
Public Sub PopulateList()
    On Error Resume Next
    Dim i           As Integer
    For i = 0 To 50
        Form1.List1.AddItem i & " ... " & Now()
    Next i
End Sub

batman1 · 13/1/20

kieu manh đã viết:
Anh @ndu96081631 ,@Hoàng Trọng Nghĩa
Thử xem sao nhé ... thấy code nó đơn giản lắm không biết đúng không nữa

ListBox của người ta nằm trên sheet, Form gì ở đây?
Mà nên nhớ đây là ListBox từ Form Controls nên không có handle đâu nhé.

ndu96081631 · 13/1/20

Hoàng Trọng Nghĩa đã viết:

Mã:

Sub btnTruoc()
    With Sheet4.Shapes("List Box 7").ControlFormat
        Dim lngIndex As Long
        lngIndex = .ListIndex - 1
        .ListIndex = WorksheetFunction.Max(lngIndex, 1)
    End With
End Sub

Sub btnSau()
    With Sheet4.Shapes("List Box 7").ControlFormat
        Dim lngIndex As Long
        lngIndex = .ListIndex + 1
        .ListIndex = WorksheetFunction.Min(.ListCount, lngIndex)
    End With
End Sub

kieu manh đã viết:

Anh @ndu96081631 ,@Hoàng Trọng Nghĩa
Thử xem sao nhé ... thấy code nó đơn giản lắm không biết đúng không nữa
Code trên Form

Mã:

Private Sub Command1_Click(Index As Integer)
    On Error Resume Next
    Select Case Index
    Case 0
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_LINEUP, 0
    Case 1
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_LINEDOWN, 0
    Case 2
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_TOP, 0
    Case 3
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_BOTTOM, 0
    Case 4
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_PAGEUP, 0
    Case 5
        SendMessageByLong Form1.List1.hwnd, WM_VSCROLL, SB_PAGEDOWN, 0
    Case Else: Exit Sub
    End Select
End Sub

Private Sub Form_Load()
    On Error Resume Next
    Call PopulateList
End Sub

Code trong Module

Mã:

Public Declare Function SendMessageByLong Lib "user32" Alias "SendMessageA" _
          (ByVal hwnd As Long, _
          ByVal wMsg As Long, _
          ByVal wParam As Long, _
          ByVal lParam As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" _
          (ByVal nIndex As Long) As Long
Public Const WM_VSCROLL = &H115
Public Const SB_LINEUP = 0
Public Const SB_LINEDOWN = 1
Public Const SB_PAGEUP = 2
Public Const SB_PAGEDOWN = 3
Public Const SB_THUMBPOSITION = 4
Public Const SB_THUMBTRACK = 5
Public Const SB_TOP = 6
Public Const SB_BOTTOM = 7
Public Const SB_ENDSCROLL = 8
Public Sub PopulateList()
    On Error Resume Next
    Dim i           As Integer
    For i = 0 To 50
        Form1.List1.AddItem i & " ... " & Now()
    Next i
End Sub

View attachment 231152

Lộn cmn tiệm rồi Mạnh à!

ListBox di chuyển Scroll theo item được lựa chọn

An.BA

Thành viên thường trực

Hoàng Trọng Nghĩa

Chuyên gia GPE

An.BA

Thành viên thường trực

Hoàng Trọng Nghĩa

Chuyên gia GPE

An.BA

Thành viên thường trực

ndu96081631

Huyền thoại GPE

An.BA

Thành viên thường trực

File đính kèm

ndu96081631

Huyền thoại GPE

leonguyenz

Thành viên gạo cội

An.BA

Thành viên thường trực

leonguyenz

Thành viên gạo cội

Hoàng Trọng Nghĩa

Chuyên gia GPE

Kiều Mạnh

I don't program, I beat code into submission!!!

Kiều Mạnh

I don't program, I beat code into submission!!!

File đính kèm

batman1

Thành viên gạo cội

ndu96081631

Huyền thoại GPE

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng