Tặng công cụ tạo ListBox với tiêu đề và Scroll ngang.

Liên hệ QC

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,610
Được thích
16,671
Giới tính
Nam
Từ khi biết về VBA, mỗi lần sinh nhật của GPE tôi đều tạo ra một chương trình để tặng các thành viên của diễn đàn. Sinh nhật lần thứ 7 của năm nay cũng thế, tôi sẽ gửi tặng các bạn một chương trình cho sự kiện sinh nhật có ý nghĩa lần này, đó là "công cụ" tạo ListBox mới, có tiêu đề như ý, và ListBox đó dù cho có nhiều cột (độ rộng hơn cả UserForm) thì cũng được scroll ngang kiểm soát.

Với ListView nói chung hay với các control 6.0 khác, thông thường chúng ta phải convert chúng thành tiếng Việt, rất khó sử dụng. Khi add dữ liệu lên, chúng ta phải chạy vòng lặp, chưa kể các controls loại này phải tải về, cài đặt rồi đăng ký rất phức tạp và rắc rối, nhưng khi sử dụng được ở máy này thì chưa chắc sử dụng được ở máy khác.

Với ListBox thì controls này đã được tích hợp sẳn trong bộ công cụ của Excel nên dễ khai thác, dễ add list bằng rowsource (range) hoặc bằng list (array) một cách dễ dàng và nhanh chóng, không cần convert Unicode tiếng Việt, sử dụng máy nào cũng được nếu máy đó có cài Excel.

Tuy nhiên với ListBox có hạn chế rất nhiều so với ListView, về tiêu đề chẳng hạn nếu dùng rowsource may ra được cái tiêu đề nhưng tiêu đề chẳng có đẹp mắt gì cả, còn dùng array cho list thì không bao giờ có được tiêu đề (mà phần đông người dùng chỉ muốn dùng mảng để gán cho List là chủ yếu). Nhưng nếu ta chế tiêu đề bằng Label thì hạn chế lớn nhất của chúng là UserForm không đủ độ rộng của nhiều cột trên ListBox, làm sao để xem các cột mà tiêu đề không chạy theo cột đây?

Công cụ tạo ListBox mới được nghĩ ra là như thế!

Như đã đề cập tại bài này:

Đố vui: Tôi đã sử dụng Controls gì?

Ở bài đó tôi chỉ đề cập đến cái form với cái ListBox có tiêu đề, đó là cái sản phẩm cuối cùng được tạo ra bởi công cụ tạo form.

Cái công cụ này chưa chắc đã được dùng với nhiều người, nhưng tôi tin chắc rằng, với các code, thủ tục tôi viết trong đó, những ai chưa có nhiều kiến thức về VBA sẽ được học tập rất nhiều từ bài viết này, chẳng hạn có Class Module, các thủ tục tạo UserForm và các controls, thêm các thủ tục trong form bằng code, các sự kiện trên form, thủ tục kết nối với VBA (Trust Access to Visual Basic Project) và đặc biệt là sản phẩm được làm ra từ công cụ này đó là LISTBOX TỰ CHẾ.

Hình ảnh cái gọi là "công cụ" của tôi:

attachment.php
Picture1.jpg

Picture2.jpg

Tôi cũng đã viết sẳn hướng dẫn sử dụng trong đó:

attachment.php
Picture3.jpg

Và hình ảnh mà sản phẩm của nó tạo ra:

attachment.php


Với một số thủ tục cơ bản:

Thủ tục Kết nối với VBA (Trust Access to Visual Basic Project)

Mã:
Sub CheckAccessVBOM()
    regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & _
    Application.Version & "\Excel\Security\AccessVBOM"
    CreateObject("WScript.Shell").RegWrite regKey, 1, "REG_DWORD"
End Sub

Sub UnCheckAccessVBOM()
    With CreateObject("WScript.Shell")
        .RegWrite regKey, 0, "REG_DWORD"
        .RegDelete regKey
    End With
End Sub

Thủ tục tạo form mới:

Mã:
Private Sub cmdCreateNewForm_Click()
    Dim MyCtrl(), i As Long
    MyCtrl = Array("txtColumnNums", "tbxColWidths", "tbxHeaders", "tbxFontSize")
    For i = 0 To UBound(MyCtrl)
        If Me(MyCtrl(i)) = "" Then
            Beep
            Me(MyCtrl(i)).SetFocus
            Exit Sub
        End If
    Next
    Dim Usform As Object, lblLeft As Double, ColNum As Long
    Call CheckAccessVBOM
    With ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
        .Properties("Height") = 200
        .Properties("Width") = 300
        .Properties("Caption") = "USERFORM WITH FRAMELIST"
        With .Designer.Add("Forms.Frame.1", "FrameList")
            .Top = 20
            .Left = 12
            .Height = 144
            .Width = 270
            .SpecialEffect = fmSpecialEffectSunken
            .BackColor = ckbMauNen.BackColor
            .ForeColor = .BackColor
            ColNum = Val(txtColumnNums) - 1
            For i = 0 To ColNum
                With .Controls.Add("Forms.Label.1", "lblCol" & i + 1)
                    .SpecialEffect = fmSpecialEffectRaised
                    .Caption = IIf(cbxCanhLe.ListIndex = 0, "   " & cbxColNum.List(i, 2), cbxColNum.List(i, 2))
                    .BackColor = ckbMauTieuDe.BackColor
                    .ForeColor = ckbMauChuTD.ForeColor
                    .TextAlign = cbxCanhLe.ListIndex + 1
                    .Font.Name = cbxFont
                    .Font.Size = 10
                    .Top = 0
                    .Height = 14
                    .Left = lblLeft
                    .Width = cbxColNum.List(i, 1) + IIf(i = ColNum, 0, 1)
                End With
                lblLeft = lblLeft + cbxColNum.List(i, 1)
            Next
            With .Controls.Add("Forms.ListBox.1", "ListBox_HTN")
                .Left = 0
                .Top = 14
                .Height = 142
                .Width = 268
                .SpecialEffect = fmSpecialEffectFlat
                .BackColor = ckbMauNen.BackColor
                .ForeColor = ckbMauChu.ForeColor
                .Font.Name = cbxFont
                .Font.Size = Val(tbxFontSize)
                .ListStyle = IIf(ckbCheck, 1, 0)
                .MultiSelect = IIf(ckbMulti, 1, 0)
            End With
        End With
        .CodeModule.InsertLines 2, AddCodeInForm
        MsgBox "UserForm moi duoc tao co ten: " & .Name
    End With
    Call UnCheckAccessVBOM
    Unload Me
End Sub

và thủ tục chính để xử lý chiều rộng của ListBox (để loại bỏ scroll ngang của ListBox) khi chạy sự kiện scroll của Frame:

Mã:
Private Sub FrameList_Scroll(ByVal ActionX As MSForms.fmScrollAction, ByVal ActionY As MSForms.fmScrollAction, ByVal RequestDx As Single, ByVal RequestDy As Single, ByVal ActualDx As MSForms.ReturnSingle, ByVal ActualDy As MSForms.ReturnSingle)
    Dim ColWid As Double, w As Long, n As Long, ColWids As String
    With ListBox_HTN
        .Width = IIf(.Width + ActualDx < 0, 0, .Width + ActualDx)
        For w = LBound(LstColArr) To UBound(LstColArr)
            n = n + 1
            ColWid = ColWid + LstColArr(w)
            If .Width <= ColWid Then
                .ColumnCount = n
                .ColumnWidths = ColWids & .Width - ColWid - LstColArr(w)
                Exit Sub
            End If
            ColWids = ColWids & LstColArr(w) & ";"
        Next
    End With
End Sub

Đó là trình bày sơ qua cái công cụ tạo ListBox trên form, các bạn nên tải file về để trải nghiệm chương trình mới này!

VBA pass: HoangTrongNghia

=======================================================

ĐÃ UPDATE FILE MỚI:
CongCuTaoListBox_V1.2.rar
 

File đính kèm

  • CongCuTaoListBox.xls
    92 KB · Đọc: 293
  • CongCuTaoListBox_V1.2.rar
    34.9 KB · Đọc: 428
Lần chỉnh sửa cuối:
Chào anh Nghĩa và các anh chị trên diễn đàn
Mình có tải file ListBoxWithHeader2.xls của anh Nghĩa về xem và thêm 2 nút lệnh LẦN 1, LẦN 2 (Xin phép anh nghĩa về điều này nha)
mục đích của mình là muốn thay đổi chỉ số ColumnCount, ColumnWidths, RowSource sau khi Form Show nhưng mình gặp một số vấn đề như sau:
Khi Form Show
- Mình click nút lệnh LẦN 1 thì thanh cuộn dọc nhảy luốn vào vị trí gần giữa Framelist (nếu click nút lệnh LẦN 1 2 lần thì thanh cuộn ngang của listBox trồi lên trên luôn)
- Mình click nút lệnh LẦN 2 thì thanh cuộn dọc củng nằm vị trí như LẦN 1 (nếu click nút lệnh LẦN 2 2 lần thì kết quả lại đúng như ý mình muốn)


Mình không biết tại sao và sửa bằng cách nào, Mình hy vọng anh Nghĩa là tác giả của file trên và các anh chị trên diễn đàn có thể giúp mình giải quyết được sự cố trên, mình rất cần ListBox có tiêu đề như vậy
Cám ơn các anh chị nhiều

Tôi đã chỉnh sửa và thay đổi một số thủ tục của form đó. Cụ thể là:

Mã:
Private Sub ListFrameSetting(ByVal LstColumnWidths As String, Optional ByVal RngTitle As Range)
    Dim c As Byte, u As Byte
    ''Vi mac dinh ta co 12 Label tieu de nen:
    For c = 1 To 12
        Me("lblCol" & c).Top = 0
        Me("lblCol" & c).Visible = False
    Next
    
    Dim ArrColWds
    Dim FrmScrWidth As Single, lblLeft As Single
    
    FrmScrWidth = Evaluate(LstColumnWidths)
    ArrColWds = Split(LstColumnWidths, "+")
    u = UBound(ArrColWds)
    
    FrameList.ScrollLeft = 0
    FrameList.ScrollBars = fmScrollBarsNone
    
    If FrameList.InsideWidth < FrmScrWidth Then
        FrameList.ScrollWidth = FrmScrWidth
        FrameList.ScrollBars = fmScrollBarsHorizontal
    Else
        FrameList.ScrollBars = fmScrollBarsNone
        ArrColWds(u) = ArrColWds(u) + FrameList.InsideWidth - FrmScrWidth
    End If
    
    For c = 0 To u
        With Me("lblCol" & c + 1)
            .Visible = True
            .Width = ArrColWds(c)
            .Left = lblLeft
        End With
        lblLeft = lblLeft + ArrColWds(c)
    Next
    
    ListBox_HTN.Left = 0
    ListBox_HTN.Top = 14.25
    ListBox_HTN.ColumnCount = u + 1
    
    If ListBox_HTN.ListStyle = fmListStyleOption Then
        ArrColWds(0) = ArrColWds(0) - 12
        ArrColWds(u) = ArrColWds(u) - 12
    End If
    
    ListBox_HTN.ColumnWidths = Join(ArrColWds, ",")
    
    ListBox_HTN.Width = FrameList.InsideWidth
    If FrameList.ScrollBars = fmScrollBarsNone Then
        ListBox_HTN.Height = FrameList.InsideHeight - ListBox_HTN.Top
    Else
        ListBox_HTN.Height = FrameList.InsideHeight
    End If
    
    If RngTitle Is Nothing Then
        For c = 1 To u + 1
            Me("lblCol" & c).Caption = "  C" & ChrW(7896) & "T " & c
        Next
    Else
        For c = 1 To u + 1
            Me("lblCol" & c).Caption = "  " & RngTitle(, c).Value
        Next
    End If
    
End Sub

Ở đây, bạn sẽ dễ dàng nhập vào các nút lệnh hơn các câu lệnh sau:

Mã:
Private Sub CommandButton2_Click()
    
    ListBox_HTN.RowSource = "LAN1"
    
[COLOR=#008000]    ''Khong co tieu de:[/COLOR]
[COLOR=#0000cd]    'ListFrameSetting "120+70+120+70+120+70"[/COLOR]
[COLOR=#008000]    [/COLOR]
[COLOR=#008000]    ''Co tieu de:[/COLOR]
[COLOR=#ff0000]    ListFrameSetting "120+70+120+70+120+70", Sheet1.Range("A1:F1")[/COLOR]
    
    CommandButton2.Enabled = False
    CommandButton3.Enabled = True
    
End Sub

Với các dòng xanh đỏ:

- Dãy số kèm theo là độ rộng của các cột trong ListBox, cấu trúc chỉ đơn giản là thêm dấu cộng (+) giữa chúng.

- Có phần Range hoặc không, có nghĩa là bạn có muốn viết tiêu đề lên các Label hay không. Nếu có thì trong vùng Range bạn viết tiêu đề như thế nào thì các Label nó hiện lên thế đó. Còn không, nó vẫn chỉ ghi CỘT 1 đến CỘT 12.

Xem File và cho ý kiến.
 

File đính kèm

  • ListBoxWithHeader_HTN.xls
    62.5 KB · Đọc: 72
Upvote 0
Tôi đã chỉnh sửa và thay đổi một số thủ tục của form đó. Cụ thể là:

Mã:
Private Sub ListFrameSetting(ByVal LstColumnWidths As String, Optional ByVal RngTitle As Range)
    Dim c As Byte, u As Byte
   .............................    
End Sub

Ở đây, bạn sẽ dễ dàng nhập vào các nút lệnh hơn các câu lệnh sau:

Mã:
Private Sub CommandButton2_Click()
    
    ListBox_HTN.RowSource = "LAN1"
    
[COLOR=#008000]''Khong co tieu de:[/COLOR]
[COLOR=#0000cd]'ListFrameSetting "120+70+120+70+120+70"[/COLOR]

[COLOR=#008000]''Co tieu de:[/COLOR]
[COLOR=#ff0000]ListFrameSetting "120+70+120+70+120+70", Sheet1.Range("A1:F1")[/COLOR]
    
    CommandButton2.Enabled = False
    CommandButton3.Enabled = True
    
End Sub

Với các dòng xanh đỏ:

- Dãy số kèm theo là độ rộng của các cột trong ListBox, cấu trúc chỉ đơn giản là thêm dấu cộng (+) giữa chúng.

- Có phần Range hoặc không, có nghĩa là bạn có muốn viết tiêu đề lên các Label hay không. Nếu có thì trong vùng Range bạn viết tiêu đề như thế nào thì các Label nó hiện lên thế đó. Còn không, nó vẫn chỉ ghi CỘT 1 đến CỘT 12.

Xem File và cho ý kiến.

Quá tuyệt anh Nghĩa ơi, nhưng chỉ có một chút vấn đề như sau:
Nếu anh kéo thanh cuộn ngang sang phải ở vị trí max thì nút hình tam giác cuối của thanh cuộn dọc listBox mất tiêu và có một điều nữa là dòng cuối cùng của listBox không xuất hiện cho dù ta có kéo thanh cuộn dọc, có cách nào khắc phục không anh.
Cám ơn anh rất nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
Quá tuyệt anh Nghĩa ơi, nhưng chỉ có một chút vấn đề như sau:
Nếu anh kéo thanh cuộn ngang sang phải ở vị trí max thì nút hình tam giác cuối của thanh cuộn dọc listBox mất tiêu và có một điều nữa là dòng cuối cùng của listBox không xuất hiện cho dù ta có kéo thanh cuộn dọc, có cách nào khắc phục không anh.
Cám ơn anh rất nhiều
Cái này tôi cũng đã thắc mắc từ lâu, chẳng hiểu nguyên lý gì mà khi dịch chuyển nó lại bị như thế, máy nào cũng bị thế, cách tốt nhất để chữa cháy, trong nguồn dữ liệu, ta nên thêm 1 hàng rỗng ở dòng cuối cùng.
 
Upvote 0
Cái này tôi cũng đã thắc mắc từ lâu, chẳng hiểu nguyên lý gì mà khi dịch chuyển nó lại bị như thế, máy nào cũng bị thế, cách tốt nhất để chữa cháy, trong nguồn dữ liệu, ta nên thêm 1 hàng rỗng ở dòng cuối cùng.
ặc em tưởng anh biết nên không trả lời bạn kia . cái này là do thuộc tính IntegraHeight = True gây ra đó anh

với bài này để chữa cháy thì ta
gọi
ListBox_HTN.RowSource = "LAN1"
sau khi gọi
ListBox_HTN.Height

để nó tính toán lại chiều cao Listbox sau khi set RowSource .
nhưng cách này vẫn chưa giải quyết được vấn đề bị mất thanh cuộn dọc khi kéo thanh cuộn ngang sang tận cùng bên phải . đố anh biết sửa sao ? hi hi
 
Upvote 0
ặc em tưởng anh biết nên không trả lời bạn kia . cái này là do thuộc tính IntegraHeight = True gây ra đó anh

với bài này để chữa cháy thì ta
gọi
ListBox_HTN.RowSource = "LAN1"
sau khi gọi
ListBox_HTN.Height

để nó tính toán lại chiều cao Listbox sau khi set RowSource .
nhưng cách này vẫn chưa giải quyết được vấn đề bị mất thanh cuộn dọc khi kéo thanh cuộn ngang sang tận cùng bên phải . đố anh biết sửa sao ? hi hi
Cái IntegraHeight này đã nói ở bài đầu rồi, không nói lại, ta có 2 lựa chọn hoặc là dùng thuộc tính ta set trước, còn lại thì dùng code (như bên dưới) để điều khiển. Riêng để không bị mất cái tam giác của ListBox ta chỉ việc chơi "tiểu xảo" một chút thôi.

Thay code này vào sẽ OK.

Mã:
Private Sub ListFrameSetting(ByVal LstColumnWidths As String, Optional ByVal RngTitle As Range)
    Dim c As Byte, u As Byte
    ''Vi mac dinh ta co 12 Label tieu de nen:
    For c = 1 To 12
        Me("lblCol" & c).Top = 0
        Me("lblCol" & c).Visible = False
    Next
    Dim ArrColWds
    Dim FrmScrWidth As Single, lblLeft As Single
    FrmScrWidth = Evaluate(LstColumnWidths)
    ArrColWds = Split(LstColumnWidths, "+")
    u = UBound(ArrColWds)
    With FrameList
        .ScrollLeft = 0
        .ScrollBars = fmScrollBarsNone
        If .InsideWidth < FrmScrWidth Then
            .ScrollWidth = [B][COLOR=#ff0000]FrmScrWidth - 1[/COLOR][/B]
            .ScrollBars = fmScrollBarsHorizontal
        Else
            .ScrollBars = fmScrollBarsNone
            ArrColWds(u) = ArrColWds(u) + .InsideWidth - FrmScrWidth
        End If
    End With
    For c = 0 To u
        With Me("lblCol" & c + 1)
            .Visible = True
            .Width = ArrColWds(c)
            .Left = lblLeft
        End With
        lblLeft = lblLeft + ArrColWds(c)
    Next
    With ListBox_HTN
        .Left = 0
        .Top = 14.25
        .ColumnCount = u + 1
        If .ListStyle = fmListStyleOption Then
            ArrColWds(0) = ArrColWds(0) - 12
            ArrColWds(u) = ArrColWds(u) - 12
        End If
        .ColumnWidths = Join(ArrColWds, ",")
        .Width = FrameList.InsideWidth
[B][COLOR=#ff0000]        .IntegralHeight = False[/COLOR][/B]
        If FrameList.ScrollBars = fmScrollBarsNone Then
            .Height = FrameList.InsideHeight - .Top
        Else
            .Height = FrameList.InsideHeight
        End If
    End With
    If RngTitle Is Nothing Then
        For c = 1 To u + 1
            Me("lblCol" & c).Caption = "  C" & ChrW(7896) & "T " & c
        Next
    Else
        For c = 1 To u + 1
            Me("lblCol" & c).Caption = "  " & RngTitle(, c).Value
        Next
    End If
End Sub
 
Upvote 0
em không biết máy anh sao chứ máy em sửa như anh vẫn không nhìn thấy dòng cuối nhỉ . hic
 
Upvote 0
em không biết máy anh sao chứ máy em sửa như anh vẫn không nhìn thấy dòng cuối nhỉ . hic
Kết hợp với thêm 1 dòng trống ở dưới (bài trước đã nói). Vì nó không tự điều chỉnh độ cao của hàng khi dùng IntegraHeight=False nên đôi khi không thấy được hàng cuối cùng! Riêng với IntegraHeight, nếu mình không chơi tiểu xảo thì dù có False hay True nó đều mất cái tam giác đó (cho nên mới théc méc, bởi khi bằng False xem như ta khóa độ cao của nó rồi sao nó vẫn cứ mất).
 
Upvote 0
Kết hợp với thêm 1 dòng trống ở dưới (bài trước đã nói). Vì nó không tự điều chỉnh độ cao của hàng khi dùng IntegraHeight=False nên đôi khi không thấy được hàng cuối cùng! Riêng với IntegraHeight, nếu mình không chơi tiểu xảo thì dù có False hay True nó đều mất cái tam giác đó (cho nên mới théc méc, bởi khi bằng False xem như ta khóa độ cao của nó rồi sao nó vẫn cứ mất).

có cách không thêm dòng trống và IntegraHeight vẫn để True và thậm chí không dùng sự kiện Private Sub FrameList_Scroll đấy . hi hi
không bao giờ có chuyện không nhìn thấy hàng cuối và không bị mất hình tam giác nhé
em biết mình kém cỏi lắm, em chỉ có ý giao lưu học hỏi anh thôi chứ không cố ý mạo phạm .
--=0


 
Upvote 0
có cách không thêm dòng trống và IntegraHeight vẫn để True và thậm chí không dùng sự kiện Private Sub FrameList_Scroll đấy . hi hi
không bao giờ có chuyện không nhìn thấy hàng cuối và không bị mất hình tam giác nhé
em biết mình kém cỏi lắm, em chỉ có ý giao lưu học hỏi anh thôi chứ không cố ý mạo phạm .
--=0
Vậy sao? Nếu có gì hay thì gửi lên để học hỏi, riêng với ListBox vì nó không có sẳn tiêu đề cột như ListView, mà nếu có chỉ có thể dùng RowSource mới chọn được thuộc tính Header mà thôi (nhưng quá xấu), còn Add hay List đều không thể có, chính vì thế mới nhờ em Frame và các Label hỗ trợ.

Thử gửi cách bạn lên xem nào rồi cùng học hỏi, cùng bàn tiếp.
 
Upvote 0
Vậy sao? Nếu có gì hay thì gửi lên để học hỏi, riêng với ListBox vì nó không có sẳn tiêu đề cột như ListView, mà nếu có chỉ có thể dùng RowSource mới chọn được thuộc tính Header mà thôi (nhưng quá xấu), còn Add hay List đều không thể có, chính vì thế mới nhờ em Frame và các Label hỗ trợ.

Thử gửi cách bạn lên xem nào rồi cùng học hỏi, cùng bàn tiếp.
chúng ta set các thuộc tính
Mã:
FrameList.ScrollBars = fmScrollBarsBoth
FrameList.KeepScrollBarsVisible = fmScrollBarsBoth
ListBox_HTN.IntegralHeight = True
xóa hết sub Private Sub FrameList_Scroll

cái ListFrameSetting em làm như vầy
Mã:
Private Sub ListFrameSetting(ByVal LstColumnWidths As String, Optional ByVal RngTitle As Range)
    Dim c As Byte, u As Byte
    ''Vi mac dinh ta co 12 Label tieu de nen:
    For c = 1 To 12
        Me("lblCol" & c).Top = 0
        Me("lblCol" & c).Visible = False
    Next
    Dim ArrColWds
    Dim FrmScrWidth As Single, lblLeft As Single
    FrmScrWidth = Evaluate(LstColumnWidths)
    ArrColWds = Split(LstColumnWidths, "+")
    u = UBound(ArrColWds)
    For c = 0 To u
        With Me("lblCol" & c + 1)
            .Visible = True
            .Width = ArrColWds(c)
            .Left = lblLeft
        End With
        lblLeft = lblLeft + ArrColWds(c)
    Next
    FrameList.ScrollWidth = lblLeft
    With ListBox_HTN
        .Left = 0
        .Top = 14.25
        .ColumnCount = u + 1
        If .ListStyle = fmListStyleOption Then
            ArrColWds(0) = ArrColWds(0) - 12
            ArrColWds(u) = ArrColWds(u) - 12
        End If
        .ColumnWidths = Join(ArrColWds, ",")
[COLOR=#008000]        '.Width = FrameList.InsideWidth[/COLOR]
        .Width = lblLeft
[COLOR=#008000]        '.IntegralHeight = False[/COLOR]
        .Height = Sheet1.Range("LAN1").Rows.Count * 15
        FrameList.ScrollHeight = .Height
    End With
    If RngTitle Is Nothing Then
        For c = 1 To u + 1
            Me("lblCol" & c).Caption = "  C" & ChrW(7896) & "T " & c
        Next
    Else
        For c = 1 To u + 1
            Me("lblCol" & c).Caption = "  " & RngTitle(, c).Value
        Next
    End If
End Sub
 
Upvote 0
chúng ta set các thuộc tính
Mã:
FrameList.ScrollBars = fmScrollBarsBoth
FrameList.KeepScrollBarsVisible = fmScrollBarsBoth
ListBox_HTN.IntegralHeight = True
xóa hết sub Private Sub FrameList_Scroll

cái ListFrameSetting em làm như vầy
Ui trời, bạn làm xong bạn thử chưa? Nếu đơn giản như thế tôi chẳng cần phí sức tạo ra nó! Hihihihi. Bạn thử trượt xuống xem, các tiêu đề nằm ở đâu hả bạn?
 
Upvote 0
Ui trời, bạn làm xong bạn thử chưa? Nếu đơn giản như thế tôi chẳng cần phí sức tạo ra nó! Hihihihi. Bạn thử trượt xuống xem, các tiêu đề nằm ở đâu hả bạn?
ừ nhỉ . còn cái tiêu đề . xem ra chỉ có thể set RowSource dư ra 1 dòng hoặc là set Height trước rồi set RowSource sau .....
 
Upvote 0
ừ nhỉ . còn cái tiêu đề . xem ra chỉ có thể set RowSource dư ra 1 dòng hoặc là set Height trước rồi set RowSource sau .....
Đương nhiên rồi, chứ làm theo kiểu kia, sao dám chắc chiều cao của mỗi List là .Rows.Count *15? Nó còn lệ thuộc vào font chữ, cỡ chữ v.v...
 
Upvote 0
Đương nhiên rồi, chứ làm theo kiểu kia, sao dám chắc chiều cao của mỗi List là .Rows.Count *15? Nó còn lệ thuộc vào font chữ, cỡ chữ v.v...
anh Nghĩa ơi . em bê nguyên code bài #25 vào file mà vẫn không nhìn thấy dấu mũi tên khi cuộn ngang sang tận cùng bên phải . tệ hơn nữa là khi cuộn ngang sang tận cùng bên phải thì không còn nhìn thấy dòng cuối nữa
anh kiểm dùm coi em làm bị thiếu ở đâu với . cảm ơn anh
 

File đính kèm

  • ListBoxWithHeader_HTN (1).xls
    49.5 KB · Đọc: 24
Upvote 0
anh Nghĩa ơi . em bê nguyên code bài #25 vào file mà vẫn không nhìn thấy dấu mũi tên khi cuộn ngang sang tận cùng bên phải . tệ hơn nữa là khi cuộn ngang sang tận cùng bên phải thì không còn nhìn thấy dòng cuối nữa
anh kiểm dùm coi em làm bị thiếu ở đâu với . cảm ơn anh
Đúng là có lúc nó biến mất! Ta lại chơi chiêu tiếp hen!

Thay vì câu lệnh thế này:

ListFrameSetting "120+70+120+70+120+70", Sheet1.Range("A1:F1")

Ta đổi thành:

ListFrameSetting "120+70+120+70+120+82", Sheet1.Range("A1:F1")

Để chi? Chút nữa ta trừ lại 12 nó cũng trở về với 70. Tức cứ cột cuối ta dự định độ rộng bao nhiêu thì ta cứ thêm vào 12.

Tại câu lệnh này:

.ScrollWidth = FrmScrWidth - 12

Vậy cho nên ta thử chơi chiêu với em nó xem có bị "khuất mặt khuất mày" nữa không nhé!

Mã:
Private Sub CommandButton2_Click()    
    ListBox_HTN.RowSource = "LAN1"    
    ''Khong co tieu de:
    'ListFrameSetting "120+70+120+70+120[B][COLOR=#0000ff]+82[/COLOR][/B]"    
    ''Co tieu de:
    ListFrameSetting "120+70+120+70+120[B][COLOR=#0000ff]+82[/COLOR][/B]", Sheet1.Range("A1:F1")    
    CommandButton2.Enabled = False
    CommandButton3.Enabled = True
End Sub

Và thủ tục điều khiển:

Mã:
Private Sub ListFrameSetting(ByVal LstColumnWidths As String, Optional ByVal RngTitle As Range)
    Dim c As Byte, u As Byte
    ''Vi mac dinh ta co 12 Label tieu de nen:
    For c = 1 To 12
        Me("lblCol" & c).Top = 0
        Me("lblCol" & c).Visible = False
    Next
    Dim ArrColWds
    Dim FrmScrWidth As Single, lblLeft As Single
    FrmScrWidth = Evaluate(LstColumnWidths)
    ArrColWds = Split(LstColumnWidths, "+")
    u = UBound(ArrColWds)
    With FrameList
        .ScrollLeft = 0
        .ScrollBars = fmScrollBarsNone
        If .InsideWidth < FrmScrWidth Then
            .ScrollWidth = FrmScrWidth [B][COLOR=#ff0000]- 12[/COLOR][/B]
            .ScrollBars = fmScrollBarsHorizontal
        Else
            .ScrollBars = fmScrollBarsNone
            ArrColWds(u) = ArrColWds(u) + .InsideWidth - FrmScrWidth
        End If
    End With
    For c = 0 To u
        With Me("lblCol" & c + 1)
            .Visible = True
            .Width = ArrColWds(c)
            .Left = lblLeft
        End With
        lblLeft = lblLeft + ArrColWds(c)
    Next
    With ListBox_HTN
        .IntegralHeight = False
        .ListStyle = fmListStyleOption
        .Left = 0
        .Top = 14.25
        .ColumnCount = u + 1
        If .ListStyle = fmListStyleOption Then
            ArrColWds(0) = ArrColWds(0) - 12
            ArrColWds(u) = ArrColWds(u) - 12
        End If
        .ColumnWidths = Join(ArrColWds, ",")
        .Width = FrameList.InsideWidth
        If FrameList.ScrollBars = fmScrollBarsNone Then
            .Height = FrameList.InsideHeight - .Top
        Else
            .Height = FrameList.InsideHeight [COLOR=#ff8c00]- 2[/COLOR]
        End If
    End With
    If RngTitle Is Nothing Then
        For c = 1 To u + 1
            Me("lblCol" & c).Caption = "  C" & ChrW(7896) & "T " & c
        Next
    Else
        For c = 1 To u + 1
            Me("lblCol" & c).Caption = "  " & RngTitle(, c).Value
        Next
    End If
End Sub
 

File đính kèm

  • ListBoxWithHeader_HTN_V2.xls
    64 KB · Đọc: 70
Upvote 0
Cái bác làm cao siêu quá, em xem muốn tìm hiểu xem có vỡ ra đc ít code nào trong đó ko nhưng khó quá, ko ngộ dc! HI
Bài đã được tự động gộp:

hình như cái bác làm bản chất vẫn là 1 listbox, tiêu đề các cột vẫn là các label, cả label và list nằm trong 1 Frame
 
Upvote 0
Từ khi biết về VBA, mỗi lần sinh nhật của GPE tôi đều tạo ra một chương trình để tặng các thành viên của diễn đàn. Sinh nhật lần thứ 7 của năm nay cũng thế, tôi sẽ gửi tặng các bạn một chương trình cho sự kiện sinh nhật có ý nghĩa lần này, đó là "công cụ" tạo ListBox mới, có tiêu đề như ý, và ListBox đó dù cho có nhiều cột (độ rộng hơn cả UserForm) thì cũng được scroll ngang kiểm soát.

Với ListView nói chung hay với các control 6.0 khác, thông thường chúng ta phải convert chúng thành tiếng Việt, rất khó sử dụng. Khi add dữ liệu lên, chúng ta phải chạy vòng lặp, chưa kể các controls loại này phải tải về, cài đặt rồi đăng ký rất phức tạp và rắc rối, nhưng khi sử dụng được ở máy này thì chưa chắc sử dụng được ở máy khác.

Với ListBox thì controls này đã được tích hợp sẳn trong bộ công cụ của Excel nên dễ khai thác, dễ add list bằng rowsource (range) hoặc bằng list (array) một cách dễ dàng và nhanh chóng, không cần convert Unicode tiếng Việt, sử dụng máy nào cũng được nếu máy đó có cài Excel.

Tuy nhiên với ListBox có hạn chế rất nhiều so với ListView, về tiêu đề chẳng hạn nếu dùng rowsource may ra được cái tiêu đề nhưng tiêu đề chẳng có đẹp mắt gì cả, còn dùng array cho list thì không bao giờ có được tiêu đề (mà phần đông người dùng chỉ muốn dùng mảng để gán cho List là chủ yếu). Nhưng nếu ta chế tiêu đề bằng Label thì hạn chế lớn nhất của chúng là UserForm không đủ độ rộng của nhiều cột trên ListBox, làm sao để xem các cột mà tiêu đề không chạy theo cột đây?

Công cụ tạo ListBox mới được nghĩ ra là như thế!

Như đã đề cập tại bài này:

Đố vui: Tôi đã sử dụng Controls gì?

Ở bài đó tôi chỉ đề cập đến cái form với cái ListBox có tiêu đề, đó là cái sản phẩm cuối cùng được tạo ra bởi công cụ tạo form.

Cái công cụ này chưa chắc đã được dùng với nhiều người, nhưng tôi tin chắc rằng, với các code, thủ tục tôi viết trong đó, những ai chưa có nhiều kiến thức về VBA sẽ được học tập rất nhiều từ bài viết này, chẳng hạn có Class Module, các thủ tục tạo UserForm và các controls, thêm các thủ tục trong form bằng code, các sự kiện trên form, thủ tục kết nối với VBA (Trust Access to Visual Basic Project) và đặc biệt là sản phẩm được làm ra từ công cụ này đó là LISTBOX TỰ CHẾ.

Hình ảnh cái gọi là "công cụ" của tôi:

attachment.php
View attachment 105383

View attachment 105384

Tôi cũng đã viết sẳn hướng dẫn sử dụng trong đó:

attachment.php
View attachment 105385

Và hình ảnh mà sản phẩm của nó tạo ra:

attachment.php


Với một số thủ tục cơ bản:

Thủ tục Kết nối với VBA (Trust Access to Visual Basic Project)

Mã:
Sub CheckAccessVBOM()
    regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & _
    Application.Version & "\Excel\Security\AccessVBOM"
    CreateObject("WScript.Shell").RegWrite regKey, 1, "REG_DWORD"
End Sub

Sub UnCheckAccessVBOM()
    With CreateObject("WScript.Shell")
        .RegWrite regKey, 0, "REG_DWORD"
        .RegDelete regKey
    End With
End Sub

Thủ tục tạo form mới:

Mã:
Private Sub cmdCreateNewForm_Click()
    Dim MyCtrl(), i As Long
    MyCtrl = Array("txtColumnNums", "tbxColWidths", "tbxHeaders", "tbxFontSize")
    For i = 0 To UBound(MyCtrl)
        If Me(MyCtrl(i)) = "" Then
            Beep
            Me(MyCtrl(i)).SetFocus
            Exit Sub
        End If
    Next
    Dim Usform As Object, lblLeft As Double, ColNum As Long
    Call CheckAccessVBOM
    With ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
        .Properties("Height") = 200
        .Properties("Width") = 300
        .Properties("Caption") = "USERFORM WITH FRAMELIST"
        With .Designer.Add("Forms.Frame.1", "FrameList")
            .Top = 20
            .Left = 12
            .Height = 144
            .Width = 270
            .SpecialEffect = fmSpecialEffectSunken
            .BackColor = ckbMauNen.BackColor
            .ForeColor = .BackColor
            ColNum = Val(txtColumnNums) - 1
            For i = 0 To ColNum
                With .Controls.Add("Forms.Label.1", "lblCol" & i + 1)
                    .SpecialEffect = fmSpecialEffectRaised
                    .Caption = IIf(cbxCanhLe.ListIndex = 0, "   " & cbxColNum.List(i, 2), cbxColNum.List(i, 2))
                    .BackColor = ckbMauTieuDe.BackColor
                    .ForeColor = ckbMauChuTD.ForeColor
                    .TextAlign = cbxCanhLe.ListIndex + 1
                    .Font.Name = cbxFont
                    .Font.Size = 10
                    .Top = 0
                    .Height = 14
                    .Left = lblLeft
                    .Width = cbxColNum.List(i, 1) + IIf(i = ColNum, 0, 1)
                End With
                lblLeft = lblLeft + cbxColNum.List(i, 1)
            Next
            With .Controls.Add("Forms.ListBox.1", "ListBox_HTN")
                .Left = 0
                .Top = 14
                .Height = 142
                .Width = 268
                .SpecialEffect = fmSpecialEffectFlat
                .BackColor = ckbMauNen.BackColor
                .ForeColor = ckbMauChu.ForeColor
                .Font.Name = cbxFont
                .Font.Size = Val(tbxFontSize)
                .ListStyle = IIf(ckbCheck, 1, 0)
                .MultiSelect = IIf(ckbMulti, 1, 0)
            End With
        End With
        .CodeModule.InsertLines 2, AddCodeInForm
        MsgBox "UserForm moi duoc tao co ten: " & .Name
    End With
    Call UnCheckAccessVBOM
    Unload Me
End Sub

và thủ tục chính để xử lý chiều rộng của ListBox (để loại bỏ scroll ngang của ListBox) khi chạy sự kiện scroll của Frame:

Mã:
Private Sub FrameList_Scroll(ByVal ActionX As MSForms.fmScrollAction, ByVal ActionY As MSForms.fmScrollAction, ByVal RequestDx As Single, ByVal RequestDy As Single, ByVal ActualDx As MSForms.ReturnSingle, ByVal ActualDy As MSForms.ReturnSingle)
    Dim ColWid As Double, w As Long, n As Long, ColWids As String
    With ListBox_HTN
        .Width = IIf(.Width + ActualDx < 0, 0, .Width + ActualDx)
        For w = LBound(LstColArr) To UBound(LstColArr)
            n = n + 1
            ColWid = ColWid + LstColArr(w)
            If .Width <= ColWid Then
                .ColumnCount = n
                .ColumnWidths = ColWids & .Width - ColWid - LstColArr(w)
                Exit Sub
            End If
            ColWids = ColWids & LstColArr(w) & ";"
        Next
    End With
End Sub

Đó là trình bày sơ qua cái công cụ tạo ListBox trên form, các bạn nên tải file về để trải nghiệm chương trình mới này!

VBA pass: HoangTrongNghia

=======================================================

ĐÃ UPDATE FILE MỚI:
CongCuTaoListBox_V1.2.rar

Chạy nó bị lỗi như hình bên dưới anh ơi.

1533179412166.png
 
Upvote 0
Upvote 0
Web KT
Back
Top Bottom