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,590
Được thích
16,653
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ỉnh sửa một số lỗi, làm gọn code.

Không biết các bạn tải file về có thấy bị lỗi gì không nhỉ? Riêng tôi thì thấy có đấy!

Lỗi này cũng đặc trưng thôi, bởi khi can thiệp vào VBA bằng code thì nếu VBA (Project) có khóa View thì sẽ bị lỗi ngay lập tức.

Tôi chờ các bạn phản hồi mà sao không thấy ai nói gì, hỏng lẽ tải file về các bạn không gặp lỗi này chăng?

Cách khắc phục: Gỡ bỏ password rồi Save lại, lần sau mở là không bị nữa!

Tôi cũng sửa một vài chỗ code cho hợp lý hơn. Các bạn tải file tại bài 1 của topic này.

File mới có tên: CongCuTaoListBox_V1.2.rar
 

File đính kèm

  • Picture1.jpg
    Picture1.jpg
    49.6 KB · Đọc: 503
Lần chỉnh sửa cuối:
Upvote 0
Tôi chờ các bạn phản hồi mà sao không thấy ai nói gì, hỏng lẽ tải file về các bạn không gặp lỗi này chăng?


Người tải về cũng có thể do tò mò, muốn xem. Nếu là công cụ quá tuyệt thì người ta sẽ muốn dùng, và do có lỗi thì người ta sẽ hỏi bằng được. Nhưng nếu sau khi xem họ thấy cũng không có nhu cầu đến thế: có thì tốt mà không có thì cũng chẳng sao. Nếu đúng thế thì có thể họ chả bỏ công ra để mà phản hồi.

Tất nhiên cũng còn cái phải sửa. Có cái thậm chí tôi không biết phải sửa như thế nào. Vì thực chất ListBox này không được làm dựa trên ListBox của Windows. Tôi mới kiểm tra qua loa thì có cảm giác như thế.

Nhưng bạn chỉ khuyên: "nên tải file về để trải nghiệm chương trình" mà không cần góp ý gì nên tôi dừng ở đây. Mà có góp ý thì có lẽ tôi sẽ "bàn ra" thôi.
 
Upvote 0
Ha ha ha! (Xin Phép BQT cho phép Em ngoài lề tí ạ,nếu không cần thiết BQT có thể xóa ạ)!
Công nhận đúng là Em xem mấy bài hoành tráng kiểu này chẳng hiểu mô tê và mục đích để làm gì nữa.
Chỉ thấy đẹp mắt nên ngắm chơi cho đỡ buồn thôi ạ! hihi Thầy Nghĩa đừng giận nhé!
Tại vì do Em ngu quá nên mới không biết nó tuyệt đến mức nào. Vì vậy Thầy xem thế nào bảo ban kèm cặp cho Em để em có thể áp dụng được những gì tinh hoa nhất của GPE ban tặng!
---------------------
Em chỉ có một góp ý bé xíu là có lẽ Thầy nên làm 1 cái tiện ích nào đó mà nó có thể áp dụng rộng dãi ấy nghĩa là ai xem cũng cảm thấy có thể nghĩ ra được là nên ứng dụng vào lĩnh vực nào đó ạ.
Theo Em đó mới là cái cần thiết. Còn với Em thì bài này của Thầy chỉ xem ngôn ngữ và lời văn của Thầy thôi em đã thấy mới toanh dường như lần đầu nghe đến.Chứ chưa xem đến là cụ thể trong file đi đến đâu và ra làm sao cả.

Nhưng Rất Cảm ơn Thầy đã bỏ công sức để tạo ra những tiện ích quí giá đến mọi người!!!
 
Lần chỉnh sửa cuối:
Upvote 0
Ha ha ha! (Xin Phép BQT cho phép Em ngoài lề tí ạ,nếu không cần thiết BQT có thể xóa ạ)!
Công nhận đúng là Em xem mấy bài hoành tráng kiểu này chẳng hiểu mô tê và mục đích để làm gì nữa.

Nói thằng ra là thế này: Công cụ trên nó vẽ giùm bạn 1 cái listBox (thay vì bạn tự mình vẽ và tự hiểu chỉnh)
Chỉ vậy thôi
Thế nên tôi thấy ứng dụng của nó không cao... vì chả lý nào ta nghiên cứu VBA mà lại lười đến mức không tự mình vẽ nỗi vài cái control?
Ngay cả cái tiêu đề thì trước giờ tôi vẫn làm thế (dùng 1 Label để giả lập) và tôi cũng tự mình hiệu chỉnh bằng tay, có khó khăn gì đâu...
 
Upvote 0
Ha ha ha! (Xin Phép BQT cho phép Em ngoài lề tí ạ,nếu không cần thiết BQT có thể xóa ạ)!
Công nhận đúng là Em xem mấy bài hoành tráng kiểu này chẳng hiểu mô tê và mục đích để làm gì nữa.
Chỉ thấy đẹp mắt nên ngắm chơi cho đỡ buồn thôi ạ! hihi Thầy Nghĩa đừng giận nhé!
Tại vì do Em ngu quá nên mới không biết nó tuyệt đến mức nào. Vì vậy Thầy xem thế nào bảo ban kèm cặp cho Em để em có thể áp dụng được những gì tinh hoa nhất của GPE ban tặng!
---------------------
Em chỉ có một góp ý bé xíu là có lẽ Thầy nên làm 1 cái tiện ích nào đó mà nó có thể áp dụng rộng dãi ấy nghĩa là ai xem cũng cảm thấy có thể nghĩ ra được là nên ứng dụng vào lĩnh vực nào đó ạ.
Theo Em đó mới là cái cần thiết. Còn với Em thì bài này của Thầy chỉ xem ngôn ngữ và lời văn của Thầy thôi em đã thấy mới toanh dường như lần đầu nghe đến.Chứ chưa xem đến là cụ thể trong file đi đến đâu và ra làm sao cả.

Nhưng Rất Cảm ơn Thầy đã bỏ công sức để tạo ra những tiện ích quí giá đến mọi người!!!


Có những thứ rất hoành tráng, nhưng chỉ một vài người quan tâm, nhưng có những hàm có sẳn trong Excel như VLOOKUP, IF, LEFT, RIGHT v.v... thì đa số người, nhất là những người bắt đầu học Excel, họ đặc biệt quan tâm, cho nên bài này chỉ dành chia sẻ học thuật và cách linh hoạt trong mỗi controls, tạm gọi là "cái khó ló cái khôn", chứ chẳng dám múa rìu qua mắt thợ.

Khi bạn thật sự cần đến form và form của bạn cũng cần có một danh sách để xem khi nhập liệu thì bạn mới có hứng thú nghiên cứu về nó, còn không thì cũng chả cần làm gì! Nhưng bạn cũng có thể xem code và ứng dụng vào vài việc cụ thể khác.

Nếu bạn gọi tôi là "Thầy", chắc phải gọi các Thầy siwtom, Thầy NDU, Sư phụ PTM, v.v... là SƯ TỔ quá! Làm ơn gọi tôi là Anh Nghĩa được rồi nếu bạn nhỏ tuổi hơn tôi! Vậy đi nha!
 
Upvote 0
1) Tất nhiên cũng còn cái phải sửa.

2) Có cái thậm chí tôi không biết phải sửa như thế nào. Vì thực chất ListBox này không được làm dựa trên ListBox của Windows. Tôi mới kiểm tra qua loa thì có cảm giác như thế.

3) ListBox này không được làm dựa trên ListBox của Windows

1) Lẽ dĩ nhiên em biết là còn phải chỉnh sửa thêm, nhưng xét cho cùng chỉ làm việc theo kiểu "chữa cháy", nhưng cũng thú vị vì mình dám nghĩ dám làm và cũng rất hiệu quả đối với công việc của em.

2) Có lẽ Thầy đang nói đến việc khi ta chọn đến một hàng nào đó, ở phía cuối cùng chẳng hạn, rồi kéo thanh cuộn ngang, cái listbox nó lại quay về dòng đầu tiên và không giữ được hàng đã chọn? Điều này cũng dễ hiểu thôi và em đã khắc phục.

3) Là một controls không dựa vào Windows thì em không hiểu ý này lắm?
 
Upvote 0
1) Lẽ dĩ nhiên em biết là còn phải chỉnh sửa thêm, nhưng xét cho cùng chỉ làm việc theo kiểu "chữa cháy", nhưng cũng thú vị vì mình dám nghĩ dám làm và cũng rất hiệu quả đối với công việc của em.

Cái này là tốt. Học lập trình thì phải viết nhiều code, luyện nhiều. Và một số code trong bài này sẽ hữu ích cho các bạn chưa biết.

2) Có lẽ Thầy đang nói đến việc khi ta chọn đến một hàng nào đó, ở phía cuối cùng chẳng hạn, rồi kéo thanh cuộn ngang, cái listbox nó lại quay về dòng đầu tiên và không giữ được hàng đã chọn? Điều này cũng dễ hiểu thôi và em đã khắc phục.

Đúng là tôi nói về cái này. Tôi nói chưa biết sửa thế nào do mới ở "bước" test thôi chứ chưa tới "bước" tìm ra cách chữa. Tôi đã khắc phục điều này, xem tập tin đính kèm

3) Là một controls không dựa vào Windows thì em không hiểu ý này lắm?

Tôi nói với hàm ý là khó có thể thao tác với ListBox này bằng cách gửi thông điệp. Vì nếu bạn tự tạo ListBox bằng API thì mọi AddItem v...v bạn thực hiện bằng cách gửi thông điệp. Ví như Delphi có control ListBox nhưng nó được tạo ra theo "qui cách" như tôi nói trên. Vậy người dùng không cần gửi thông điệp (tức không cần biết API) mà chỉ gọi phương thức AddItem (như trong Excel ...), còn Delphi sẽ biến cái gọi "AddItem" thành gửi thông điệp. Bằng cách này người dùng có 2 cách thêm mục vào ListBox: tự gửi thông điệp tới window ListBox (dĩ nhiên là window nên ListBox có handle), hoặc gọi ListBox.AddItem và Delphi "biến" nó thành gửi thông điệp.

Tất nhiên tôi thử gửi vài thông điệp tới cái mà tôi cho là window ListBox nhưng không thàng công - hình như tôi chỉ đọc được nó có mấy cột thì phải. Tôi không nhớ rõ vì thử thông điệp này ngay từ đầu nên quên rồi.
-------------------
Về code chắc chắn sẽ có ích cho những bạn biết viết code nhưng chưa biết cách làm "một vài việc".

Về bản thân control ListBox thì tôi có nhận xét như sau:

1. Về lỗi thì cũng còn 1 lỗi nữa (do tôi test sơ qua thôi). Nếu trong CP thiết lập ký tự "," (dấu phẩy) là dấu thập phân thì nhấn nút tạo UserForm1 sẽ có lỗi.

2. Tôi thấy ufsCreateForm và code của nó không cần thiết. Mục đích cuối cùng của bạn là tạo UserForm1, tức cái "sườn" - template. Vì khi người dùng cần cho project cụ thể của mình thì họ vẫn phải thay đổi kích thước UserForm1, Label, ListBox, thiết lập nhiều thuộc tính chứ đâu chỉ số cột, kích thước cột hay mầu chữ mầu nền? Và cũng chính vì thế nên dù có cái template thì họ vẫn phải dùng Properties Window. Vậy thì tạo cái ufsCreateForm để làm gì? Mà tạo thì chỉ mua thêm việc cho người dùng thôi: Import ufsCreateForm vào project --> tạo UserForm1 --> Remove ufsCreateForm.
Và tất cả mọi lựa chọn về kích thước, mầu mè đều có thể chọn trong Properties Window.
Vậy thì theo tôi: tạo UserForm1 bằng tay + code. Khi tạo UserForm1 cũng chỉ cần đặt Label, ListBox vào Frame mà không cần kích thước, định vị hay chọn số cột, xác định kích thước mỗi cột làm gì. Tất cả mọi thiết lập thuộc tính người dùng tiềm năng sẽ tự thiết lập trong Properties Window. Còn việc tính kích thước của Label, ListBox và định vị chúng ta sẽ làm trong code.

Trong tập tin đính kèm tôi thử rút gọn project của bạn chỉ còn cái "sườn" - template SecretForm. Việc tạo ra cái "sườn" này bằng tay là việc "làm một lần dùng ngàn lần". Và chắc chắn ít việc và nhanh hơn bạn thiết kế và viết code cho ufsCreateForm. Trong tập tin đính kèm tôi cũng sửa và xóa nhiều code, vd. code của Scroll chỉ có 1 dòng.
-------------
a. Template. Khi tải tập tin về thì mở ra và export SecretForm vào thư mục nào đó, vd. thư mục My Library.

b. Thực hiện project cần tới ListBox. Ta mở project --> Import SecretForm --> thiết lập các thuộc tính cho Label (không cần thiết lập kích thước, định vị vì có làm thì code cũng sẽ thay đổi), cho ListBox (không định vị, kích thước), ít nhất phải thiết lập ColumnCount, ColumnWidths. Code sẽ trên cơ sở ColumnWidths và kích thước của Frame để xác định kích thước của Label, ListBox và định vị chúng.

c. Template đã có sẵn 6 Label cho 6 cột. Nếu chỉ cần < 6 cột thì cũng không cần xóa. Nếu cần hơn 6 cột thì tạo thêm với chú ý là Label đặt trên Frame và tên phải là lblCol***, tức lblCol7, lblCol8 ...

d. Trong UserForm_Initialize đã có sẵn code định vị Label và ListBox. Nếu cần thì viết thêm code, vd. code nạp dữ liệu vào ListBox.

e. Sau khi sửa và rút gọn thì tôi chỉ test sơ qua. Nếu bạn quan tâm thì test thêm. Nhiều khi người khác nhìn thấy cái mà mà mình không nhìn thấy. Theo qui luật: cái lỗi của người nó như con voi, nhìn rõ mồn một, còn lỗi của mình thì sao nó cứ như con kiến ấy.
-------------
Toàn bộ code của template SecretForm
Mã:
Private Sub UserForm_Initialize()
    CalculateControls
    
End Sub

Private Sub CalculateControls()
Dim index As Long, s As String, cWidths As String, lblLeft As Double, Arr, lb As msforms.Label, count As Long
    init = True
    cWidths = ListBox_HTN.ColumnWidths
    s = Replace(cWidths, "pt", "")
    s = Replace(s, ";", "+")
    With FrameList
        .ScrollBars = fmScrollBarsHorizontal
        .ScrollLeft = 0
        .ScrollWidth = Evaluate(s)
        ListBox_HTN.Width = .InsideWidth
        ListBox_HTN.Height = .InsideHeight - ListBox_HTN.Top
    End With
    Arr = Split(s, "+")
    For index = LBound(Arr) To UBound(Arr)
        Set lb = Me("lblCol" & index + 1)
        If Not lb Is Nothing Then
            With lb
                .Left = lblLeft
                .Top = 0
                .Width = Arr(index)
                .Height = ListBox_HTN.Top - 1
            End With
        End If
        lblLeft = lblLeft + Arr(index)
    Next
    
'    Nếu có số Label nhiều hơn cần thiết thì cho những Label không cần ra khỏi tầm mắt
    On Error Resume Next
    For index = index To Me.Controls.count
        Set lb = Me.Controls("lblCol" & index + 1)
        If Err Then Exit For
        lb.Left = lblLeft
    Next
    
    If ListBox_HTN.ListStyle = fmListStyleOption Then
        ListBox_HTN.ColumnWidths = Replace(cWidths, Arr(0), Arr(0) - 12, , 1)
    End If
    init = False
End Sub

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)
    If Not init And (ActualDx <> 0) Then ListBox_HTN.Width = ListBox_HTN.Width + ActualDx
End Sub
 

File đính kèm

  • ListBoxWithHeader.rar
    24.9 KB · Đọc: 200
Lần chỉnh sửa cuối:
Upvote 0
...
Trong tập tin đính kèm tôi thử rút gọn project của bạn chỉ còn cái "sườn" - template SecretForm. Việc tạo ra cái "sườn" này bằng tay là việc "làm một lần dùng ngàn lần". Và chắc chắn ít việc và nhanh hơn bạn thiết kế và viết code cho ufsCreateForm. Trong tập tin đính kèm tôi cũng sửa và xóa nhiều code, vd. code của Scroll chỉ có 1 dòng.
...

Tải file Thầy về hồi sáng, rồi mới xem file chiều nay, em thấy cần bổ sung hoặc bỏ bớt vài điểm:

1) Thấy biến init không cần thiết nên bỏ. Lý do, khi sự kiện scroll, điều kiện chỉ cần ActualDx <> 0 là đủ.

2) Thêm: Nếu tổng độ rộng của các cột nhỏ hơn InsideHeight của Frame thì tính lại cho cột cuối, nếu không các Label mà mình loại ra sẽ dồn lại, đồng thời không cho xuất hiện cái scrollbar của Frame.

Code sẽ sửa lại như sau:

Thêm biến ở ngoài:

Mã:
Private IsUseScroll As Boolean

Với thủ tục CalculateControls:

Mã:
Private Sub ListFrameSetting()
    Dim Index As Long, lblLeft As Double, scrW As Double, _
        AllColWidths As String, cWidths As String, _
        lb As msforms.Label, Arr As Variant
    
    cWidths = ListBox_HTN.ColumnWidths
    AllColWidths = Replace(Replace(cWidths, "pt", ""), ";", "+")
[COLOR=#0000ff]    scrW = Evaluate(AllColWidths)[/COLOR]
    Arr = Split(AllColWidths, "+")
    
[COLOR=#0000ff]    With ListBox_HTN[/COLOR]
[COLOR=#0000ff]        .IntegralHeight = False [/COLOR][COLOR=#008000]'Co dinh chieu cao cua ListBox[/COLOR]
[COLOR=#0000ff]        .Left = 0[/COLOR]
[COLOR=#0000ff]        .Top = 14.25[/COLOR]
[COLOR=#0000ff]    End With[/COLOR]

    With FrameList
        ListBox_HTN.Height = .InsideHeight - ListBox_HTN.Top
        ListBox_HTN.Width = .InsideWidth
[COLOR=#0000ff]        If .InsideWidth < scrW Then[/COLOR]
            .ScrollBars = fmScrollBarsHorizontal
            .ScrollLeft = 0
            .ScrollWidth = scrW
[COLOR=#0000ff]        Else[/COLOR]
[COLOR=#008000]            'Neu tong do rong cac cot nho hon InsideHeight[/COLOR]
[COLOR=#008000]            'thi dieu chinh lai do rong cua cot cuoi:[/COLOR]
[COLOR=#0000ff]            IsUseScroll = True[/COLOR]
[COLOR=#0000ff]            .ScrollBars = fmScrollBarsNone[/COLOR]
[COLOR=#0000ff]            Arr(UBound(Arr)) = Arr(UBound(Arr)) + .InsideWidth - scrW[/COLOR]
[COLOR=#0000ff]        End If[/COLOR]
    End With
    
    For Index = LBound(Arr) To UBound(Arr)
        Set lb = Me("lblCol" & Index + 1)
        If Not lb Is Nothing Then
            With lb
                .Top = 0
                .Height = 14.25
                .Left = lblLeft
                .Width = Arr(Index)
            End With
        End If
        lblLeft = lblLeft + Arr(Index)
    Next
    
    On Error Resume Next
    For Index = Index To Me.Controls.Count
        Set lb = Me("lblCol" & Index + 1)
        If Err Then Exit For
        lb.Left = lblLeft
    Next
    
    If ListBox_HTN.ListStyle = fmListStyleOption Then
        ListBox_HTN.ColumnWidths = Replace(cWidths, Arr(0), Arr(0) - 12, , 1)
    End If
End Sub

Sự kiện FrameList_Scroll:

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)
    If IsUseScroll Or ActualDx = 0 Then Exit Sub
    ListBox_HTN.Width = ListBox_HTN.Width + ActualDx
End Sub
 

File đính kèm

  • ListBoxWithHeader2.xls
    41.5 KB · Đọc: 126
Lần chỉnh sửa cuối:
Upvote 0
Tải file Thầy về hồi sáng, rồi mới xem file chiều nay, em thấy cần bổ sung hoặc bỏ bớt vài điểm:

1) Thấy biến init không cần thiết nên bỏ. Lý do, khi sự kiện scroll, điều kiện chỉ cần ActualDx <> 0 là đủ.

Cũng có thể trong một khâu test nào đó tôi thêm vào sau đó không kiểm tra lại nữa.

2) Thêm: Nếu tổng độ rộng của các cột nhỏ hơn InsideHeight của Frame thì tính lại cho cột cuối, nếu không các Label mà mình loại ra sẽ dồn lại, đồng thời không cho xuất hiện cái scrollbar của Frame.

Code sẽ sửa lại như sau:

Chuyện test kỹ và sửa code là chuyện chi tiết kỹ thuật. Bạn sửa thế nào cho chạy chuẩn là được.

Ý của tôi chỉ là

1. Loại bỏ ufsCreateForm. Ta tự tạo bằng tay SecretForm (tạo 1 lần dùng nghìn lần). Chuyện tạo mặc định 6 hay 4 hay 10 Label cũng là chuyện chi tiết, tùy người thiết kế cho hợp lý.

2. Code của Scroll có thể đơn giản hơn nhiều.

3. SecretForm vào thời điểm "chào buổi sáng" đã có code định vị. Mọi code cần thiết thì thêm vào.

4. Mọi thuộc tính người dùng tự thiết lập trong Properties Window (chứ không phải trong ufsCreateForm). Với ListBox thì phải thiết lập ít nhất là ColumnCount và ColumnWidths

Chỉ thế thôi. Tôi là người nêu ra ý tưởng còn chuyện thực hiện thì anh A sẽ tự làm theo cách của mình, anh B cũng có kiểu của mình.
 
Upvote 0
À, nếu nói về định vị thì tôi có ý tưởng thế này.
Nói cho cùng thì cái ta cần chỉ là ListBox. Label, Frame chẳng qua là được thêm vào với mục đích ...
Vậy thì:

0. Sub định vị gọi trong UserForm_Initialize sau code nhập dữ liệu vào ListBox.

1. Width và Height của Frame ta xác định dựa theo Width và Height của ListBox. Hiện thời thì ta làm ngược lại, tức ListBox phụ thuộc vào Frame.

2. Ta tính tổng các cột. Nếu tổng các cột > ListBox_HTN.Width thì ta cho hiện ScrollBar còn ngược lại thì ta cho ListBox_HTN.Width = "tổng các cột" - tức lúc này thì "tổng các cột" xác định độ rộng của LIstBox.

3. Ta thay lb.Left = lblLeft bằng lb.Top = FrameList.Height. Như vậy thì cứ cuộn ScrollBar mỏi tay vẫn không thấy các Label "thừa"

4. Scroll không có Init cũng chả có IsUseScroll
-------------
Để minh họa cho ý tưởng trên thì tôi sửa code trước của tôi (sửa trong notepad, không test) thành

Mã:
Private Sub UserForm_Initialize()
'Dim Arr(), r As Long, c As Long
'    ReDim Arr(1 To 100, 1 To ListBox_HTN.ColumnCount)
'    For r = LBound(Arr) To UBound(Arr)
'        For c = LBound(Arr, 2) To UBound(Arr, 2)
'            Arr(r, c) = "Tr" & ChrW(7885) & "ng Ngh" & ChrW(297) & "a" & r & "/ " & c
'        Next c
'    Next r
'    ListBox_HTN.List = Arr
    
    CalculateControls
End Sub

Private Sub CalculateControls()
Dim index As Long, s As String, cWidths As String, lblLeft As Double, Arr, lb As msforms.Label, colWidths As Double
    cWidths = ListBox_HTN.ColumnWidths
    s = Replace(cWidths, "pt", "")
    s = Replace(s, ";", "+")
    With FrameList
        colWidths = Evaluate(s)
        If colWidths > ListBox_HTN.Width Then
            .ScrollBars = fmScrollBarsHorizontal
            .ScrollLeft = 0
            .ScrollWidth = colWidths
        Else
            ListBox_HTN.Width = colWidths
        End If
        .Width = ListBox_HTN.Width + 3
        .Height = ListBox_HTN.Top + ListBox_HTN.Height
    End With
    Arr = Split(s, "+")
    For index = LBound(Arr) To UBound(Arr)
        Set lb = Me("lblCol" & index + 1)
        If Not lb Is Nothing Then
            With lb
                .Left = lblLeft
                .Top = 0
                .Width = Arr(index)
                .Height = ListBox_HTN.Top - 1
            End With
        End If
        lblLeft = lblLeft + Arr(index)
    Next
    On Error Resume Next
    For index = index To Me.Controls.count
        Set lb = Me.Controls("lblCol" & index + 1)
        If Err Then Exit For
        lb.Top = FrameList.Height
    Next

    If ListBox_HTN.ListStyle = fmListStyleOption Then
        ListBox_HTN.ColumnWidths = Replace(cWidths, Arr(0), Arr(0) - 12, , 1)
    End If
End Sub

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)
    If ActualDx <> 0 Then ListBox_HTN.Width = ListBox_HTN.Width + ActualDx
End Sub
 
Upvote 0
Sẳn vấn đề ListBox, tôi có một form với 14 cái textbox, giả sử rằng tôi sẽ nhập liệu từ 14 textbox này vào mỗi hàng, tức mỗi hàng có 14 cột. Lưu ý cho, với AddItem cho ListBox, nó chỉ cho phép nhập đúng 10 cột, từ cột thứ 11 là nó báo lỗi đấy nhé!

Tôi nhập lần 1 cho hàng 1, rồi nhập lần 2 cho hàng 2, rồi nhập hàng n cho hàng n, hỏi các bạn tôi sẽ nhập như thế nào để có được kết quả như trong hình? (hỏi đố đấy nhé, vì tôi đã có đáp án).

attachment.php
 

File đính kèm

  • ListBox.jpg
    ListBox.jpg
    91.4 KB · Đọc: 206
  • AddList.xls
    31 KB · Đọc: 67
Upvote 0
Sẳn vấn đề ListBox, tôi có một form với 14 cái textbox, giả sử rằng tôi sẽ nhập liệu từ 14 textbox này vào mỗi hàng, tức mỗi hàng có 14 cột. Lưu ý cho, với AddItem cho ListBox, nó chỉ cho phép nhập đúng 10 cột, từ cột thứ 11 là nó báo lỗi đấy nhé!

Tôi nhập lần 1 cho hàng 1, rồi nhập lần 2 cho hàng 2, rồi nhập hàng n cho hàng n, hỏi các bạn tôi sẽ nhập như thế nào để có được kết quả như trong hình? (hỏi đố đấy nhé, vì tôi đã có đáp án).

attachment.php

Bắt buộc phải dùng AddItem?
Nếu thế thì bạn đã làm thế này?

Mã:
Private Sub Nhap_lieu_Click()
Dim r As Long, c As Long
    ListBox1.AddItem TextBox1.Text
    For c = 1 To 13
        ListBox1.List(ListBox1.ListCount - 1, c) = Me.Controls("TextBox" & c + 1).Text
    Next c
End Sub

Private Sub UserForm_Initialize()
Dim arr(0 To 0, 0 To 13) As String
    ListBox1.List = arr
    ListBox1.Clear
End Sub

Nếu làm khác thì để tính tiếp.
 
Upvote 0
Bắt buộc phải dùng AddItem?
Nếu thế thì bạn đã làm thế này?

Mã:
Private Sub Nhap_lieu_Click()
Dim r As Long, c As Long
    ListBox1.AddItem TextBox1.Text
    For c = 1 To 13
        ListBox1.List(ListBox1.ListCount - 1, c) = Me.Controls("TextBox" & c + 1).Text
    Next c
End Sub

Private Sub UserForm_Initialize()
Dim arr(0 To 0, 0 To 13) As String
    ListBox1.List = arr
    ListBox1.Clear
End Sub

Nếu làm khác thì để tính tiếp.


Đúng là không có gì qua mắt được Thầy hết đó, lẽ ra Thầy phải trả lời sau cùng mới phải nhỉ?

Khi dùng ListBox1.List = Arr (với Arr phải là mảng 2 chiều nha), thì dù nhiều cột hơn 10 nó cũng cho phép, nhưng với AddItem thì lại chỉ giới hạn 10. Cũng vô tình dùng mảng tạo trước cột, sau đó mới AddItem thêm thì nó lại cho phép add vượt quá 10 cột!

Chẳng hiểu Anh Bill xây dựng như thế nào mà xảy ra tình trạng lỗi như vậy nữa!

Cám ơn Thầy đã trả lời rất chính xác! Đây cũng là một kinh nghiệm mới cho mọi người nếu chưa bao giờ "vọc" với AddItem.
 
Lần chỉnh sửa cuối:
Upvote 0
A Nghĩa chỉnh lại code tạo Regkey "AccessVBOM" nhé.
+ Trước khi chạy form cần kiểm tra AccessVBOM đã được tạo chưa? Giá trị hiện tại có phải 1 không? Nếu chưa có thì thông báo người dùng "Chương trình yêu cầu chạy file "AccessVBOM.REG" để tạo...
+ Nếu user người dùng chạy với account (Windows) thường hoặc trong Windows Vista, 7,8 chạy với UAC được bật, khi đó Excel chạy ở chế độ an toàn, người dùng không thể tạo AccessVBOM. Vậy cần Export key AccessVBOM ra file đại loại như "AccessVBOM.REG" để chạy từ ngoài Excel khi đó mới có khả năng tạo key được.
 
Upvote 0
A Nghĩa chỉnh lại code tạo Regkey "AccessVBOM" nhé.
+ Trước khi chạy form cần kiểm tra AccessVBOM đã được tạo chưa? Giá trị hiện tại có phải 1 không? Nếu chưa có thì thông báo người dùng "Chương trình yêu cầu chạy file "AccessVBOM.REG" để tạo...
+ Nếu user người dùng chạy với account (Windows) thường hoặc trong Windows Vista, 7,8 chạy với UAC được bật, khi đó Excel chạy ở chế độ an toàn, người dùng không thể tạo AccessVBOM. Vậy cần Export key AccessVBOM ra file đại loại như "AccessVBOM.REG" để chạy từ ngoài Excel khi đó mới có khả năng tạo key được.

Xử lý AccessVBOM này rất kỳ lạ, nếu ta check thủ công và check bằng code nó hoàn toàn không hiểu nhau thì phải! Khi dùng code để check, rồi quay ra thủ công bỏ check là nó không hiểu và không chạy, mà có chạy nó cũng không cho can thiệp vào Trust Access.

Vậy theo Anh phải xử lý sao đây?

Đây là thủ tục tạo file Text ở ngoài và gọi nó thực hiện code:

[GPECODE=vb]Sub WriteVBS()

Dim objFile As Object, codePath As String

codePath = ActiveWorkbook.path & "\reg_setting.vbs"

Set objFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(codePath, 2, True)

With objFile
.WriteLine ("On Error Resume Next")
.WriteLine ("")
.WriteLine ("Dim WshShell")
.WriteLine ("Set WshShell = CreateObject(""WScript.Shell"")")
.WriteLine ("")
.WriteLine ("Dim strRegPath")
.WriteLine ("Dim Application_Version")
.WriteLine ("Application_Version = """ & Application.Version & """")
.WriteLine ("strRegPath = ""HKEY_CURRENT_USER\Software\Microsoft\Office\"" & Application_Version & ""\Excel\Security\AccessVBOM""")
.WriteLine ("WshShell.RegWrite strRegPath, 1, ""REG_DWORD""")
.WriteLine ("")
.WriteLine ("If Err.Code <> 0 Then")
.WriteLine (" MsgBox ""Error"" & Chr(13) & Chr(10) & Err.Source & Chr(13) & Chr(10) & Err.Message")
.WriteLine ("End If")
.WriteLine ("")
.WriteLine ("WScript.Quit")
.Close
End With

Set objFile = Nothing


CreateObject("Shell.Application").Open (codePath)
End Sub
[/GPECODE]

Thủ tục kiểm tra đã tạo key chưa:

[GPECODE=vb]Function TestIfKeyExists(ByVal path As String)


Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
On Error Resume Next
WshShell.RegRead path
If Err.Number <> 0 Then
Err.Clear
TestIfKeyExists = False
Else
TestIfKeyExists = True
End If
On Error GoTo 0
End Function[/GPECODE]

Thủ tục chính để chạy code:

[GPECODE=vb]Sub CheckAccessVBOM()
Dim strRegPath As String
strRegPath = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & _
Application.Version & "\Excel\Security\AccessVBOM"
If Not TestIfKeyExists(strRegPath) Then Call WriteVBS
End Sub
[/GPECODE]

Và sau khi chạy code để thoát Form hay thoát File ta đặt thủ tục hủy key:

[GPECODE=vb]Sub UnCheckAccessVBOM()
Dim strRegPath As String
strRegPath = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & _
Application.Version & "\Excel\Security\AccessVBOM"
If TestIfKeyExists(strRegPath) Then
With CreateObject("WScript.Shell")
.RegWrite strRegPath, 0, "REG_DWORD"
.RegDelete strRegPath
End With
Dim codePath As String
codePath = ActiveWorkbook.path & "\reg_setting.vbs"
With CreateObject("Scripting.FileSystemObject")
If .FileExists(codePath) Then
.DeleteFile codePath
End If
End With
End If
End Sub[/GPECODE]
 
Upvote 0
A Nghĩa chỉnh lại code tạo Regkey "AccessVBOM" nhé.
+ Trước khi chạy form cần kiểm tra AccessVBOM đã được tạo chưa? Giá trị hiện tại có phải 1 không? Nếu chưa có thì thông báo người dùng "Chương trình yêu cầu chạy file "AccessVBOM.REG" để tạo...
+ Nếu user người dùng chạy với account (Windows) thường hoặc trong Windows Vista, 7,8 chạy với UAC được bật, khi đó Excel chạy ở chế độ an toàn, người dùng không thể tạo AccessVBOM. Vậy cần Export key AccessVBOM ra file đại loại như "AccessVBOM.REG" để chạy từ ngoài Excel khi đó mới có khả năng tạo key được.

Thấy trong module "mdl_Public" có hàm tạo key value 'CheckAccessVBOM"
Mã:
Sub CheckAccessVBOM()
'HKEY_LOCAL_MACHINE hoac HKEY_CURRENT_USER
    regKey = "[COLOR="#FF0000"]HKEY_LOCAL_MACHINE[/COLOR]\Software\Microsoft\Office\" & _
    Application.Version & "\Excel\Security\AccessVBOM"
    CreateObject("WScript.Shell").RegWrite regKey, 1, "REG_DWORD"
End Sub

Can thiệp vào Registry với root key "HKEY_LOCAL_MACHINE" là account đăng nhập Windows phải là quyền Admin và chế độ UAC phải để tắt hoặc Level = Low mới thực hiện được. Các Windows Vista->8 hiện nay phần lớn ngầm định UAC là mở nên code trong ứng dụng không can ghi được vào khu vực quan trọng của Windows mà chỉ có thể đọc. Vì thế trong góp ý bài trên mình gợi ý là tạo key trong file .REG (Export key trong ứng dụng Registy của Windows).

Trong đoạn code vừa đăng bài trên của a Nghĩa lại thấy root key "HKEY_CURRENT_USER" nên hình như chưa thống nhất một nơi đọc và ghi trong Registry? Vì vậy có những chuyện "vô lý".
 
Upvote 0
Thấy trong module "mdl_Public" có hàm tạo key value 'CheckAccessVBOM"
Mã:
Sub CheckAccessVBOM()
'HKEY_LOCAL_MACHINE hoac HKEY_CURRENT_USER
    regKey = "[COLOR=#FF0000]HKEY_LOCAL_MACHINE[/COLOR]\Software\Microsoft\Office\" & _
    Application.Version & "\Excel\Security\AccessVBOM"
    CreateObject("WScript.Shell").RegWrite regKey, 1, "REG_DWORD"
End Sub

Can thiệp vào Registry với root key "HKEY_LOCAL_MACHINE" là account đăng nhập Windows phải là quyền Admin và chế độ UAC phải để tắt hoặc Level = Low mới thực hiện được. Các Windows Vista->8 hiện nay phần lớn ngầm định UAC là mở nên code trong ứng dụng không can ghi được vào khu vực quan trọng của Windows mà chỉ có thể đọc. Vì thế trong góp ý bài trên mình gợi ý là tạo key trong file .REG (Export key trong ứng dụng Registy của Windows).

Trong đoạn code vừa đăng bài trên của a Nghĩa lại thấy root key "HKEY_CURRENT_USER" nên hình như chưa thống nhất một nơi đọc và ghi trong Registry? Vì vậy có những chuyện "vô lý".


Vậy theo Anh nên làm như thế nào là ổn định và không bị lỗi hả Anh? Trình độ của em thì không nghĩ tới được, Anh giúp em nhé! Cám ơn Anh.
 
Upvote 0
Vậy theo Anh nên làm như thế nào là ổn định và không bị lỗi hả Anh? Trình độ của em thì không nghĩ tới được, Anh giúp em nhé! Cám ơn Anh.

Để đơn giản thì có thể làm như sau:

1. Tạo file .REG để thiết lập AccessVBOM = 1
Mở ứng dụng RegEdit, tạo key AccessVBOM thủ công. Chọn key "Security" vào menu File->Export và lưu với file có tên như là "SetAccessVBOM.reg". Khi người dùng chạy File "SetAccessVBOM.reg" Windows sẽ thực hiện việc tạo key và thiết lập giá trị như lúc ta tạo thủ công.

2. Vào module sửa lại cấu trúc code như sau:
Mã:
Sub Main()
    If Not AccessVBOM_Is_Valid Then
        MsgBox "Xin hay chay file ""SetAccessVBOM.reg"" de thiet lap moi truong VBE.", vbCritical
        Exit Sub
    End If
[COLOR="#008000"]    'If AccessVBOM_Is_Valid then continue
    '...[/COLOR]
End Sub

Function AccessVBOM_Is_Valid() As Boolean
    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    Dim strRegPath As String
    strRegPath = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & _
                 Application.Version & "\Excel\Security\AccessVBOM"
    On Error Resume Next
    AccessVBOM_Is_Valid = WshShell.RegRead(strRegPath) = 1
    Set WshShell = Nothing
End Function
 
Upvote 0
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
 

File đính kèm

  • ListBoxWithHeader2.xls
    44.5 KB · Đọc: 29
Upvote 0
Web KT
Back
Top Bottom