VBA Excel - Workbook

1. Mở Workbook

Sub OpenWorkbook()
    Workbooks.Open Filename:="C:\Path\To\Your\File.xlsx"
End Sub
    

2. Đóng Workbook

Sub CloseWorkbook()
    Workbooks("File.xlsx").Close SaveChanges:=False
End Sub
    

3. Lưu Workbook

Sub SaveWorkbook()
    ThisWorkbook.Save
End Sub
    

4. Lưu Workbook với tên khác

Sub SaveWorkbookAs()
    ThisWorkbook.SaveAs Filename:="C:\Path\To\Your\NewFile.xlsx"
End Sub
    

5. Tạo Workbook mới

Sub CreateNewWorkbook()
    Workbooks.Add
End Sub
    

6. Lấy tên Workbook hiện tại

Sub GetWorkbookName()
    MsgBox ThisWorkbook.Name
End Sub
    

7. Lấy đường dẫn Workbook hiện tại

Sub GetWorkbookPath()
    MsgBox ThisWorkbook.Path
End Sub
    

8. Liệt kê tất cả các Workbook đang mở

Sub ListAllWorkbooks()
    Dim wb As Workbook
    For Each wb In Workbooks
        Debug.Print wb.Name
    Next wb
End Sub
    

9. Kích hoạt Workbook khác

Sub ActivateWorkbook()
    Workbooks("File.xlsx").Activate
End Sub
    

10. Lưu tất cả Workbook đang mở

Sub SaveAllWorkbooks()
    Dim wb As Workbook
    For Each wb In Workbooks
        wb.Save
    Next wb
End Sub
    

11. Bảo vệ Workbook với mật khẩu

Sub ProtectWorkbook()
    ThisWorkbook.Protect Password:="yourpassword"
End Sub
    

12. Bỏ bảo vệ Workbook

Sub UnprotectWorkbook()
    ThisWorkbook.Unprotect Password:="yourpassword"
End Sub
    

13. Kiểm tra nếu Workbook đã được bảo vệ

Sub CheckProtection()
    If ThisWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected."
    Else
        MsgBox "Workbook is not protected."
    End If
End Sub
    

14. Tự động mở Workbook chỉ đọc

Sub OpenWorkbookReadOnly()
    Workbooks.Open Filename:="C:\Path\To\Your\File.xlsx", ReadOnly:=True
End Sub
    

15. Lấy số lượng Worksheet trong Workbook

Sub CountWorksheets()
    MsgBox "There are " & ThisWorkbook.Sheets.Count & " sheets in this workbook."
End Sub
    

16. Tạo bản sao của Workbook

Sub CopyWorkbook()
    ThisWorkbook.SaveCopyAs "C:\Path\To\Your\CopyFile.xlsx"
End Sub
    

17. Tự động lưu Workbook trước khi đóng

Sub SaveBeforeClose()
    ThisWorkbook.Save
    ThisWorkbook.Close
End Sub
    

18. Mở Workbook và kích hoạt Worksheet cụ thể

Sub OpenAndActivateSheet()
    Dim wb As Workbook
    Set wb = Workbooks.Open(Filename:="C:\Path\To\Your\File.xlsx")
    wb.Sheets("YourSheetName").Activate
End Sub
    

19. Kiểm tra nếu Workbook đã mở

Function IsWorkbookOpen(wbName As String) As Boolean
    Dim wb As Workbook
    On Error Resume Next
    Set wb = Workbooks(wbName)
    On Error GoTo 0
    IsWorkbookOpen = Not wb Is Nothing
End Function
    

20. Đổi tên Workbook

Sub RenameWorkbook()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    wb.SaveAs Filename:=wb.Path & "\NewName.xlsx"
End Sub
    

21. Thay đổi thuộc tính của Workbook

Sub SetWorkbookProperties()
    With ThisWorkbook
        .Title = "My Workbook Title"
        .Subject = "Subject of Workbook"
        .Author = "Your Name"
        .Comments = "These are my comments"
    End With
End Sub
    

22. Bảo vệ cấu trúc Workbook

Sub ProtectWorkbookStructure()
    ThisWorkbook.Protect Password:="yourpassword", Structure:=True
End Sub
    

23. Bỏ bảo vệ cấu trúc Workbook

Sub UnprotectWorkbookStructure()
    ThisWorkbook.Unprotect Password:="yourpassword"
End Sub
    

24. Kiểm tra ngày giờ Workbook được lưu lần cuối

Sub LastSavedDate()
    MsgBox "Workbook last saved on: " & ThisWorkbook.BuiltinDocumentProperties("Last Save Time")
End Sub
    

25. Tạo một bản sao Workbook và mở bản sao đó

Sub CreateAndOpenCopy()
    Dim newFilePath As String
    newFilePath = ThisWorkbook.Path & "\CopyOf_" & ThisWorkbook.Name
    ThisWorkbook.SaveCopyAs Filename:=newFilePath
    Workbooks.Open Filename:=newFilePath
End Sub
    

26. Đếm số lượng Sheets cụ thể trong Workbook

Sub CountSpecificSheets()
    Dim ws As Worksheet
    Dim count As Integer
    count = 0
    For Each ws In ThisWorkbook.Sheets
        If ws.Name Like "Sheet*" Then count = count + 1
    Next ws
    MsgBox "Number of sheets starting with 'Sheet': " & count
End Sub
    

27. Sao lưu Workbook trước khi lưu

Sub BackupBeforeSave()
    Dim backupPath As String
    backupPath = ThisWorkbook.Path & "\Backup_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".xlsx"
    ThisWorkbook.SaveCopyAs Filename:=backupPath
    ThisWorkbook.Save
End Sub
    

28. Tạo một Workbook mới từ Template

Sub CreateWorkbookFromTemplate()
    Workbooks.Add Template:="C:\Path\To\Your\Template.xltx"
End Sub
    

29. Sử dụng Workbook Open Event để chạy macro khi mở Workbook

Private Sub Workbook_Open()
    MsgBox "Welcome to my Workbook!"
End Sub
    

30. Sao chép Workbook sang một địa chỉ khác

Sub CopyWorkbookToLocation()
    Dim destPath As String
    destPath = "C:\Path\To\DestinationFolder\" & ThisWorkbook.Name
    ThisWorkbook.SaveCopyAs Filename:=destPath
End Sub
    

31. Sử dụng Workbook BeforeClose Event

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    MsgBox "Are you sure you want to close?"
End Sub
    

32. Xác định nếu Workbook đã thay đổi

Sub CheckIfWorkbookChanged()
    If ThisWorkbook.Saved = False Then
        MsgBox "The workbook has been modified since the last save."
    Else
        MsgBox "No changes have been made since the last save."
    End If
End Sub
    

33. Xóa tất cả các macro trong Workbook

Sub DeleteAllMacros()
    Dim VBComp As Object
    For Each VBComp In ThisWorkbook.VBProject.VBComponents
        If VBComp.Type = 1 Then ThisWorkbook.VBProject.VBComponents.Remove VBComp
    Next VBComp
End Sub
    

34. Gửi Workbook qua Email

Sub SendWorkbookEmail()
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "recipient@example.com"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject"
        .Body = "Here is the body of the email."
        .Attachments.Add ThisWorkbook.FullName
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
    

35. Lưu Workbook dưới dạng PDF

Sub SaveWorkbookAsPDF()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & ws.Name & ".pdf"
    Next ws
End Sub
    

36. Tạo một Danh sách Workbook Tự Động

Sub ListAllWorkbooksInFolder()
    Dim folderPath As String
    Dim fileName As String
    Dim i As Integer
    folderPath = "C:\Path\To\Folder\"
    fileName = Dir(folderPath & "*.xls*")
    i = 1
    Do While fileName <> ""
        Cells(i, 1).Value = fileName
        fileName = Dir
        i = i + 1
    Loop
End Sub
    

37. Thêm Trang tính Mới với Tên Tùy Chỉnh

Sub AddNewSheetWithName()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "NewSheetName"
End Sub
    

38. Chuyển đổi Dữ liệu từ Workbook này sang Workbook khác

Sub TransferDataBetweenWorkbooks()
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet

    Set sourceWorkbook = ThisWorkbook
    Set targetWorkbook = Workbooks.Open("C:\Path\To\TargetWorkbook.xlsx")

    Set sourceSheet = sourceWorkbook.Sheets("Sheet1")
    Set targetSheet = targetWorkbook.Sheets("Sheet1")

    sourceSheet.Range("A1:B10").Copy Destination:=targetSheet.Range("A1")

    targetWorkbook.Save
    targetWorkbook.Close
End Sub
    

39. Thiết lập Mật khẩu cho Workbook

Sub ProtectWorkbookWithPassword()
    ThisWorkbook.SaveAs Filename:="C:\Path\To\Workbook.xlsx", Password:="yourpassword"
End Sub
    

40. Tạo Bản sao Workbook và Đổi tên theo Ngày hiện tại

Sub SaveCopyWithDate()
    Dim newFileName As String
    newFileName = ThisWorkbook.Path & "\Backup_" & Format(Now, "yyyy-mm-dd") & ".xlsx"
    ThisWorkbook.SaveCopyAs Filename:=newFileName
End Sub
    

41. Bảng tìm kiếm

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Calculate
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim searchValue As String
    Dim searchRange As Range
    Dim cell As Range
    Dim firstFound As Range
    Dim foundCount As Integer
    
    ' Ch? kích ho?t khi ô B1 thay d?i
    If Target.Address = "$B$1" Then
        searchValue = Target.Value
        Set searchRange = Me.Range("B2:C130")
        foundCount = 0
        Set firstFound = Nothing

        ' Dò tìm giá tr? trong ph?m vi và ch?n các ô ch?a giá tr? tìm th?y
        For Each cell In searchRange
            If InStr(1, cell.Value, searchValue, vbTextCompare) > 0 Then
                cell.Interior.Color = RGB(255, 255, 0) ' Tô màu vàng cho ô ch?a giá tr?
                foundCount = foundCount + 1
                If firstFound Is Nothing Then
                    Set firstFound = cell ' Luu ô d?u tiên tìm th?y giá tr?
                End If
            Else
                cell.Interior.ColorIndex = 0 ' Xóa màu n?n c?a các ô không kh?p
            End If
        Next cell

        ' Hi?n th? s? lu?ng giá tr? tìm th?y trong ô C1
        Me.Range("C1").Value = foundCount & " gia tri duoc tim thay."

        If foundCount > 0 Then
            firstFound.Select ' Ch?n ô d?u tiên tìm th?y giá tr?
        End If
    End If
End Sub

    

42. Mở khóa Sheet bị khóa bằng mật khẩu số tối đa 8 ký tự

Sub UnprotectSheet()
    Dim i As Long
    Dim maxLen As Integer
    Dim password As String
    Dim startTime As Single
    Dim elapsedTime As Single
    
    On Error Resume Next
    maxLen = 8
    startTime = Timer

    For Length = 1 To maxLen
        For i = 0 To 10 ^ Length - 1
            password = Format(i, String(Length, "0"))
            ActiveSheet.Unprotect password
            If ActiveSheet.ProtectContents = False Then
                elapsedTime = Timer - startTime
                MsgBox "Mat khau la: " & password & vbNewLine & _
                       "Thoi gian tim duoc la: " & Format(elapsedTime, "0.00") & " giay"
                Exit Sub
            End If
        Next i
    Next Length
    MsgBox "Khong tim thay mat khau."
End Sub