ListView cũ của Microsoft lập trình cho VB6, VBA không hỗ trợ unicode, 64-bit, họ đã dừng phát triển. BSAC với BSListView là giải pháp thay thế để hỗ trợ unicode và 64-bit cùng với nhiều thuộc tính mới nhất.

Bài viết này hướng dẫn cách lập trình VBA với control BSListView để tạo ListView hiển thị unicode, gộp nhóm các dòng, hiển thị ảnh/icon, chuỗi unicode.

(Nếu bạn muốn xem ví dụ tạo BSListView đơn giản hơn để dễ hiểu - Bài 1 xem tại đây)

1. Cài đặt activex BSAC.ocx

Việc này chỉ phải làm lần đầu tiên. Nếu cài Add-in A-Tools sẽ tự động cài. Nếu bạn muốn tải riêng BSAC cùng các ví dụ mẫu thì vào đây: https://atoolspro.com/products/bsac-bluesofts-activex-controls.html

2. Nhúng activex BSAC vào project

+ Trong VB6:
- Tạo Project
- Vào menu Project->Components: tìm và chọn BSAC.ocx
(BSAC 32-bit tại C:\Windows\SysWow64\)

+ Trong VBA: 
- ALT+F11 (Vào Visual Basic Application)
- Vào menu Insert->Userform
- Vào menu Tools->References...: tìm và chọn BSAC.ocx
(BSAC 32-bit: tại C:\Windows\SysWow64\
BSAC 64-bit: tại C:\Windows\System32\)

Xem thêm tại: https://atoolspro.com/install-activex-controls-bsac-manually.html

- Nhấp chuột phải trên Toolbox, chọn "Additional Controls..." rồi check các controls dùng cho lập trình, như BSImageList, BSListView, BSTreeView, BSListBox, BSComboBox, BSTaskPaneX, BSTooltip,...



3. Tạo giao diện có ListView trên Form/Userform

- Kéo thả BSListView vào Form/Userform. Chỉnh kích thước , vị trí phù hợp
- Kéo BSButton vào form, đặt Name: "cmdAdd", Text: "Thêm"
- Kéo BSButton vào form, đặt Name: "cmdRemove", Text: Xóa"
- Kéo BSImageList vào form (để lưu icon hiển thị cho BSListView).
Từ control BSImageList bạn nên thiết lập thuộc tính ColorDepth là cd32Bit để nhận ảnh màu sắc đầy đủ.

Nhấp chuột phải, chọn Properties, chọn (Custom) trong cửa sổ Properties, nạp các ảnh (icon, jpec, png...) vào điều khiển.

Thiết lập Font các control là "Tahoma".

4. Lập trình hiển thị ListView có unicode với control BSListView

Mở cửa sổ code của Form/Userform, dán toàn bộ code dưới đây vào trong

'SOURCE CODE BEGIN--------
Option Explicit 
Private Sub UserForm_Initialize() 
   'Setup BSListView
   'Thiet lap ImageList to BSListView
   Set BSListView1.ImageList = BSImageList1 
   BSListView1.View = vsReport 
   BSListView1.RowSelect = True 
   BSListView1.CheckBoxes = True  'Show checkbox
   BSListView1.GroupView = True  'View grouping
   BSListView1.hGroupImageList = BSImageList1.Handle 
   BSListView1.ReadOnly = True  'Prevent item editing
   'Add columns to BSListView
   'Column: Caption, Width, ImageIndex
   ' Caption: use UNC() convert VNI/TCVN3 to unicode
   Dim lc As BSListColumn 
   Set lc = BSListView1.Columns.Add(UNC("Ngµy"), 110, 1) 
   lc.Alignment = taCenter 
   Set lc = BSListView1.Columns.Add(UNC("Tªn hµng"), 170, 2) 
   Set lc = BSListView1.Columns.Add(UNC("Sè l­îng"), 90) 
   lc.Alignment = taCenter 
   Set lc = BSListView1.Columns.Add(UNC("§¬n gi¸"), 100) 
   lc.Alignment = taRightJustify 
   Set lc = BSListView1.Columns.Add(UNC("Thµnh tiÒn "), 100, 3) 
   lc.Alignment = taRightJustify 
   'Add Group (BSListGroup)
   Dim lg As BSListGroup 
   Dim li As BSListItem, I As Long 
   BSListView1.Items.BeginUpdate  'High speed
   On Error GoTo lbEndUpdate 
   Set lg = BSListView1.Groups.Add(UNC("§iÖn tö"), UNC("C¸c mÆt hµng nh­ tivi, m¸y tÝnh, ®iÖn tho¹i"), "dientu", 0) 
   lg.FooterAlign = taRightJustify 
   'Add row (BSListItem)
   Set li = BSListView1.Items.Add(Date, 1) 
   'Add column
   li.SubItems.Add UNC("M¸y tÝnh "), 2 
   li.SubItems.Add 1 
   li.SubItems.Add Format(15000000, "#,##0") 
   li.SubItems.Add Format(15000000, "#,##0") 
   Set li.Group = lg 
   'Add row (BSListItem)
   Set li = BSListView1.Items.Add(Date, 1) 
   'Add column
   li.SubItems.Add UNC("§iÖn tho¹i"), 2 
   li.SubItems.Add 1 
   li.SubItems.Add Format(10000000, "#,##0") 
   li.SubItems.Add Format(10000000, "#,##0") 
   Set li.Group = lg 
   lg.Footer = UNC("Céng: ") & Format(25000000, "#,##0") 
   Set lg = BSListView1.Groups.Add(UNC("Gia dông"), UNC("C¸c thiÕt bÞ dïng cho nÊu n­íng nh­ nåi, xoong nåi"), "giadung", 0) 
   lg.FooterAlign = taRightJustify 
   Dim Total As Double 
   For I = 1 To 6 
      'Add row (BSListItem)
      Set li = BSListView1.Items.Add(Date, 1) 
      'Add column
      li.SubItems.Add UNC("Ch¶o n­íng ") & I, 2 
      li.SubItems.Add 1 
      li.SubItems.Add Format(5000000, "#,##0") 
      li.SubItems.Add Format(5000000, "#,##0") 
      Set li.Group = lg 
      Total = Total + 5000000 
   Next 
   lg.Footer = UNC("Céng: ") & Format(Total, "#,##0") 
lbEndUpdate: 
   BSListView1.Items.EndUpdate 
   If Err <> 0 Then 
      MsgBox Err.Description, vbCritical 
   End If 
End Sub 
'-----------------------------------------------------------------------
'Get item info when selected
Private Sub BSListView1_OnSelectItem(ByVal Item As BSAC.BSListItem, ByVal IsSelected As Boolean) 
   'Get item info when it is selected
   Label1.Caption = IIf(Item.Checked, "Checked", "Uncheck") & " | " & Item.SubItems(0) & " | " & Item.SubItems(1) & " | " & Item.SubItems(2) & " | " & Item.SubItems(3) 
End Sub 
'-----------------------------------------------------------------------
'BSAC.BSListView: create ListView with unicode
'Use UNC() convert VNI/TCVN3 to unicode
Private Sub cmdAdd_OnClick() 
   'Add row (BSListItem)
   Dim lg As BSListGroup, li As BSListItem, I As Long 
   If Not BSListView1.Selected Is Nothing Then 
      Set lg = BSListView1.Selected.Group 
   Else 
      Set lg = BSListView1.Groups(0) 
   End If 
   'Add row (BSListItem)
   Set li = BSListView1.Items.Add(Date, 1) 
   'Add column
   li.SubItems.Add UNC("MÆt hµng míi thªm lóc") & Format(Now, "mm:ss"), 2 
   li.SubItems.Add 1 
   li.SubItems.Add Format(20000000, "#,##0") 
   li.SubItems.Add Format(20000000, "#,##0") 
   Set li.Group = lg 
   'Calculate Total of items in group
   UpdateGroupTotal lg 
End Sub 
'-----------------------------------------------------------------------
Private Sub cmdRemove_OnClick() 
   If BSListView1.Selected Is Nothing Then 
      MsgBoxW "Please select an item.", vbCritical 
      Exit Sub 
   End If 
   Dim lg As BSListGroup 
   Set lg = BSListView1.Selected.Group 
   BSListView1.Selected.Delete 
   'Update Total in group
   UpdateGroupTotal lg 
End Sub 
'-----------------------------------------------------------------------
Sub UpdateGroupTotal(ByVal lg As BSListGroup) 
   Dim Total As Double, I& 
   Dim li As BSListItem 
   For I = 0 To BSListView1.Items.Count - 1 
      Set li = BSListView1.Items(I) 
      If li.Group.Key = lg.Key Then 
         Total = Total + Val(li.SubItems(3)) 
      End If 
   Next 
   lg.Footer = UNC("Céng: ") & Format(Total, "#,##0") 
   lg.FooterAlign = taRightJustify 
End Sub 
'SOURCE CODE END--------

Nếu VB6 thay tên sự kiện "UserForm_Initialize()" thành "Form_Load()"

Sau khi chạy bạn được màn hình như hình sau: (*) Lưu ý: dùng group trong BSAC bạn nên cập nhật phiên bản BSAC v3.1.0.12 hoặc nâng cấp Add-in A-Tools từ trang web này.

BSAC.ocx là một activex hỗ trợ unicode, hỗ trợ 32-bit, 64-bit với đầy đủ controls như BSListView, BSTreeView, BSImageList, BSTaskPane,...