1. Hiển thị mặc định Page1 trên Userform VBA Excel, bạn có thể sử dụng câu lệnh sau:
UserForm1.MultiPage1.Value = 0
2. Hiển thị ngày tháng năm hiện tại trong một TextBox trong UserForm:
Private Sub UserForm_Initialize()
TextBox1.Value = Format(Date, "dd/mm/yyyy")
End Sub
3. Lấy dữ liệu từ một trang tính (Sheet) và hiển thị nó trong một ListBox trong UserForm:
Private Sub UserForm_Initialize()
Dim lastRow As Long
Dim i As Long
With ThisWorkbook.Sheets("Sheet1") 'Thay "Sheet1" bằng tên trang tính của bạn
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastRow
ListBox1.AddItem .Cells(i, 1).Value 'Thay "ListBox1" bằng tên ListBox của bạn, và "1" bằng cột muốn lấy dữ liệu
Next i
End With
End Sub
ví dụ: Lấy toàn bộ dữ liệu sheets DATA vào Listbox1
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("DATA")
With Me.ListBox1
.ColumnCount = ws.Range("A1").End(xlToRight).Column
.List = ws.Range("A1").CurrentRegion.value
End With
4. Tạo nút tìm kiếm và tìm kiếm mọi thứ trong listbox khi bạn gõ từ khóa trong textbox (txttimkiem). Ví dụ sau cho listbox có 22 cột dữ liệu.
Private Sub txttimkiem_Change()
Dim arr(), kq(), i As Long, a As Long, dk As String
dk = UCase(txttimkiem.Text) 'gap dk cho text nhap vao o tim kiem
arr = Sheets("DATA").Range("A1:V" & Sheets("DATA").Range("B" & Rows.Count).End(3).row).value
ReDim kq(1 To UBound(arr, 1), 1 To 22) '22 cot du lieu
For i = 1 To UBound(arr, 1)
If UCase(arr(i, 1)) Like "*" & dk & "*" Or _
UCase(arr(i, 2)) Like "*" & dk & "*" Or _
UCase(arr(i, 3)) Like "*" & dk & "*" Or _
UCase(arr(i, 4)) Like "*" & dk & "*" Or _
UCase(arr(i, 5)) Like "*" & dk & "*" Or _
UCase(arr(i, 6)) Like "*" & dk & "*" Or _
UCase(arr(i, 7)) Like "*" & dk & "*" Or _
UCase(arr(i, 8)) Like "*" & dk & "*" Or _
UCase(arr(i, 9)) Like "*" & dk & "*" Or _
UCase(arr(i, 10)) Like "*" & dk & "*" Or _
UCase(arr(i, 11)) Like "*" & dk & "*" Or _
UCase(arr(i, 12)) Like "*" & dk & "*" Or _
UCase(arr(i, 13)) Like "*" & dk & "*" Or _
UCase(arr(i, 14)) Like "*" & dk & "*" Or _
UCase(arr(i, 15)) Like "*" & dk & "*" Or _
UCase(arr(i, 16)) Like "*" & dk & "*" Or _
UCase(arr(i, 17)) Like "*" & dk & "*" Or _
UCase(arr(i, 18)) Like "*" & dk & "*" Or _
UCase(arr(i, 19)) Like "*" & dk & "*" Or _
UCase(arr(i, 20)) Like "*" & dk & "*" Or _
UCase(arr(i, 21)) Like "*" & dk & "*" Or _
UCase(arr(i, 22)) Like "*" & dk & "*" Then
a = a + 1
kq(a, 1) = arr(i, 1)
kq(a, 2) = arr(i, 2)
kq(a, 3) = arr(i, 3)
kq(a, 4) = arr(i, 4)
kq(a, 5) = arr(i, 5)
kq(a, 6) = arr(i, 6)
kq(a, 7) = arr(i, 7)
kq(a, 8) = arr(i, 8)
kq(a, 9) = arr(i, 9)
kq(a, 10) = arr(i, 10)
kq(a, 11) = arr(i, 11)
kq(a, 12) = arr(i, 12)
kq(a, 13) = arr(i, 13)
kq(a, 14) = arr(i, 14)
kq(a, 15) = arr(i, 15)
kq(a, 16) = arr(i, 16)
kq(a, 17) = arr(i, 17)
kq(a, 18) = arr(i, 18)
kq(a, 19) = arr(i, 19)
kq(a, 20) = arr(i, 20)
kq(a, 21) = arr(i, 21)
kq(a, 22) = arr(i, 22)
End If
Next i
ListBox1 = ""
ListBox1.Clear
ListBox1.List = kq 'Gan tro lai listbox
5. xuất toàn bộ dữ liệu trong ListBox sang một tệp Excel mới:
Private Sub xuatdata_Click()
Dim i As Integer
Dim j As Integer
Dim answer As Integer
answer = MsgBox("Ban co muon xuat du lieu sang file Excel moi khong?", vbYesNo + vbQuestion, "Xac nhan")
If answer = vbNo Then
Exit Sub
End If
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlWorkBook = xlApp.Workbooks.Add
Set xlWorkSheet = xlWorkBook.Sheets(1)
For i = 0 To Me.ListBox1.ListCount - 1
For j = 0 To Me.ListBox1.ColumnCount - 1
xlWorkSheet.Cells(i + 1, j + 1).value = Me.ListBox1.List(i, j)
Next j
Next i
xlWorkSheet.Columns.AutoFit
End Sub
6. Vô hiệu hóa nút close user form vab excel
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
End If
End Sub
7. Tạo sẵn thu mục SAOLUU và bấm nút Saoluu sẽ lưu file vào thư mục dó
Private Sub saoluu_Click()
Dim fso As Object
Dim MyPath As String
Dim FileName As String
Set fso = CreateObject("Scripting.FileSystemObject")
MyPath = ThisWorkbook.Path & "\SAOLUU\"
If Not fso.FolderExists(MyPath) Then
fso.CreateFolder (MyPath)
End If
'Create the file name with the current date and time
FileName = "Data_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".xlsm"
'Copy the current workbook to the SAOLUU folder
ThisWorkbook.SaveCopyAs MyPath & FileName
'Display a message box to indicate that the backup was successful
MsgBox "Backup successfully completed!", vbInformation
Set fso = Nothing
End Sub