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:
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
cho em hỏi chút, code em có chỉnh lại một chút để phù hợp cho mấy trường hợp nữa, và em có thêm code để thêm Frame phụ trong Frame chính, trong file em gửi có trường hợp nếu có 2 listbox thì việc thêm Frame bị lỗi, nếu bấm dừng code thì bị đóng luôn excel, kể cả sau khi đóng Form , anh có thể giúp em kiểm tra xem trường hợp vậy là bị sao ạ, nếu bỏ qua lỗi thì nó chỉ chạy được trên List cuối cùng

1676703904925.png
 

File đính kèm

  • ListBoxWithHeader 3.xlsm
    55 KB · Đọc: 8
Upvote 0
Web KT
Back
Top Bottom