Các bước thực hiện thêm Macro mới
Bước 1 — Tạo PERSONAL.XLSB
Xem (View) → Macro → Ghi Macro (Record Macro).
Ở mục Lưu macro trong / Store macro in, chọn:
Personal Macro Workbook / Sổ làm việc Macro Cá nhân
Đặt tên bất kỳ, ví dụ TaoPersonal → OK → sau đó bấm Dừng ghi
(Stop Recording).
Excel sẽ tự tạo file PERSONAL.XLSB.
Bước 2 — Mở VBA
Nhấn:
Alt + F11
Sau đó nhìn bên trái, bạn sẽ thấy:
VBAProject (PERSONAL.XLSB)
Ads Code
Chọn:
PERSONAL.XLSB → Insert → Module
Bước 3 — Dán macro này
Option Explicit
Sub KhoaMoTatCaSheet()
Dim wb As Workbook
Dim ws As Worksheet
Dim o As Range
Dim rngFormula As Range
Dim MatKhau As String
Dim CheDoKhoa As Boolean
Dim SoSheetXuLy As Long
Dim SoSheetBoQua As Long
Dim SoSheetLoi As Long
Dim SoOCoLoi As Long
Dim DSBoQua As String
Dim DSSheetLoi As String
Dim DSCongThucLoi As String
Dim NoiDung As String
Dim LoiBaoVe As String
Dim LoiChiTiet As String
Dim TenSheet As String
Dim GiaTriAn As Variant
Dim KiemTraThanhCong As Boolean
Dim LoiDocThuocTinh As Long
Dim ScreenCu As Boolean
Dim EventsCu As Boolean
'========================================
' 1. THIET LAP
'========================================
If ActiveWorkbook Is Nothing Then
MsgBox "Khong co workbook dang mo.", _
vbExclamation, "LOI"
Exit Sub
End If
Set wb = ActiveWorkbook
MatKhau = "0943836131"
ScreenCu = Application.ScreenUpdating
EventsCu = Application.EnableEvents
On Error GoTo XuLyLoi
Application.ScreenUpdating = False
Application.EnableEvents = False
'========================================
' 2. XAC DINH CHE DO KHOA / MO
'
' Con sheet chua khoa -> KHOA
' Tat ca da khoa -> MO
'========================================
CheDoKhoa = False
For Each ws In wb.Worksheets
If Not ws.ProtectContents Then
CheDoKhoa = True
Exit For
End If
Next ws
'========================================
' 3. DUYET TAT CA SHEET
'========================================
For Each ws In wb.Worksheets
TenSheet = ws.Name
'------------------------------------
' 3A. KIEM TRA TRANG THAI SHEET
'------------------------------------
If CheDoKhoa Then
If ws.ProtectContents Then
' Sheet da khoa tu truoc
SoSheetBoQua = SoSheetBoQua + 1
DSBoQua = DSBoQua & vbCrLf & _
"- " & ws.Name & _
" (Da khoa san)"
GoTo SheetTiepTheo
End If
Else
'--------------------------------
' CHE DO MO KHOA
'--------------------------------
If ws.ProtectContents Then
Err.Clear
On Error Resume Next
ws.Unprotect Password:=MatKhau
LoiBaoVe = Err.Description
Err.Clear
On Error GoTo XuLyLoi
If ws.ProtectContents Then
SoSheetLoi = SoSheetLoi + 1
If LoiBaoVe = "" Then
LoiBaoVe = _
"Khong xac dinh duoc loi"
End If
DSSheetLoi = DSSheetLoi & _
vbCrLf & "- " & ws.Name & _
" | " & LoiBaoVe
GoTo SheetTiepTheo
End If
SoSheetXuLy = SoSheetXuLy + 1
End If
End If
'====================================
' 4. TIM CAC O CO CONG THUC
'====================================
Set rngFormula = Nothing
Err.Clear
On Error Resume Next
Set rngFormula = _
ws.UsedRange.SpecialCells( _
xlCellTypeFormulas)
Err.Clear
On Error GoTo XuLyLoi
'====================================
' 5. AN / HIEN CONG THUC
'====================================
If Not rngFormula Is Nothing Then
' Thu xu ly toan bo vung truoc
Err.Clear
On Error Resume Next
rngFormula.FormulaHidden = CheDoKhoa
Err.Clear
On Error GoTo XuLyLoi
' Kiem tra lai tung o cong thuc
For Each o In rngFormula.Cells
GiaTriAn = Empty
KiemTraThanhCong = False
LoiChiTiet = ""
' Doc trang thai FormulaHidden
Err.Clear
On Error Resume Next
GiaTriAn = o.FormulaHidden
LoiDocThuocTinh = Err.Number
LoiChiTiet = Err.Description
Err.Clear
On Error GoTo XuLyLoi
If LoiDocThuocTinh = 0 Then
If VarType(GiaTriAn) = vbBoolean Then
If CBool(GiaTriAn) = CheDoKhoa Then
KiemTraThanhCong = True
End If
End If
End If
'--------------------------------
' Neu chua dung thi xu ly lai
'--------------------------------
If Not KiemTraThanhCong Then
Err.Clear
On Error Resume Next
o.FormulaHidden = CheDoKhoa
' Neu o gop bi loi thi thu
' xu ly ca vung MergeArea
If Err.Number <> 0 Then
If o.MergeCells Then
Err.Clear
o.MergeArea.FormulaHidden = _
CheDoKhoa
End If
End If
LoiChiTiet = Err.Description
' Kiem tra lai ket qua
Err.Clear
GiaTriAn = Empty
GiaTriAn = o.FormulaHidden
LoiDocThuocTinh = Err.Number
If LoiDocThuocTinh <> 0 Then
LoiChiTiet = Err.Description
End If
Err.Clear
On Error GoTo XuLyLoi
KiemTraThanhCong = False
If LoiDocThuocTinh = 0 Then
If VarType(GiaTriAn) = _
vbBoolean Then
If CBool(GiaTriAn) = _
CheDoKhoa Then
KiemTraThanhCong = True
End If
End If
End If
'----------------------------
' GHI LAI O CO LOI
'----------------------------
If Not KiemTraThanhCong Then
SoOCoLoi = SoOCoLoi + 1
If LoiChiTiet = "" Then
LoiChiTiet = _
"Khong doi duoc " & _
"trang thai FormulaHidden"
End If
If SoOCoLoi <= 30 Then
DSCongThucLoi = _
DSCongThucLoi & _
vbCrLf & "- Sheet: " & _
ws.Name & _
" | O: " & _
o.Address(False, False) & _
" | " & LoiChiTiet
End If
End If
End If
Next o
End If
'====================================
' 6. KHOA SHEET
'====================================
If CheDoKhoa Then
Err.Clear
On Error Resume Next
ws.Protect _
Password:=MatKhau, _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
LoiBaoVe = Err.Description
Err.Clear
On Error GoTo XuLyLoi
' Kiem tra sheet da khoa that chua
If ws.ProtectContents Then
SoSheetXuLy = _
SoSheetXuLy + 1
Else
SoSheetLoi = SoSheetLoi + 1
If LoiBaoVe = "" Then
LoiBaoVe = _
"Sheet van chua duoc khoa"
End If
DSSheetLoi = DSSheetLoi & _
vbCrLf & "- " & ws.Name & _
" | " & LoiBaoVe
End If
End If
SheetTiepTheo:
Next ws
'========================================
' 7. THONG BAO CHE DO KHOA
'========================================
If CheDoKhoa Then
NoiDung = _
"DA HOAN THANH KHOA SHEET" & vbCrLf & _
String(35, "-") & vbCrLf & _
"Da khoa moi: " & SoSheetXuLy & _
" sheet" & vbCrLf & _
"Da khoa tu truoc: " & _
SoSheetBoQua & " sheet" & vbCrLf & _
"Khong khoa duoc: " & _
SoSheetLoi & " sheet" & vbCrLf & _
"O khong an duoc cong thuc: " & _
SoOCoLoi
' Danh sach sheet KHONG khoa duoc
NoiDung = NoiDung & vbCrLf & vbCrLf & _
"SHEET KHONG KHOA DUOC:"
If DSSheetLoi <> "" Then
NoiDung = NoiDung & DSSheetLoi
Else
NoiDung = NoiDung & _
vbCrLf & "- Khong co"
End If
' Danh sach sheet da khoa tu truoc
NoiDung = NoiDung & vbCrLf & vbCrLf & _
"SHEET DA KHOA TU TRUOC:"
If DSBoQua <> "" Then
NoiDung = NoiDung & DSBoQua
Else
NoiDung = NoiDung & _
vbCrLf & "- Khong co"
End If
NoiDung = NoiDung & vbCrLf & vbCrLf & _
"Van cho phep Filter va PivotTable."
'========================================
' 8. THONG BAO CHE DO MO KHOA
'========================================
Else
NoiDung = _
"DA HOAN THANH MO KHOA" & vbCrLf & _
String(35, "-") & vbCrLf & _
"Da mo: " & SoSheetXuLy & _
" sheet" & vbCrLf & _
"Khong mo duoc: " & _
SoSheetLoi & " sheet" & vbCrLf & _
"O khong hien lai duoc cong thuc: " & _
SoOCoLoi
NoiDung = NoiDung & vbCrLf & vbCrLf & _
"SHEET KHONG MO DUOC:"
If DSSheetLoi <> "" Then
NoiDung = NoiDung & DSSheetLoi
Else
NoiDung = NoiDung & _
vbCrLf & "- Khong co"
End If
End If
'========================================
' 9. THONG BAO LOI CONG THUC
'========================================
NoiDung = NoiDung & vbCrLf & vbCrLf & _
"CHI TIET XU LY CONG THUC:"
If DSCongThucLoi <> "" Then
NoiDung = NoiDung & DSCongThucLoi
If SoOCoLoi > 30 Then
NoiDung = NoiDung & vbCrLf & _
"... Con " & (SoOCoLoi - 30) & _
" o loi chua hien thi."
End If
Else
NoiDung = NoiDung & vbCrLf & _
"- Khong phat hien loi."
End If
'========================================
' 10. KET THUC
'========================================
Application.EnableEvents = EventsCu
Application.ScreenUpdating = ScreenCu
MsgBox NoiDung, vbInformation, _
"KHOA / MO SHEET"
Exit Sub
'========================================
' 11. XU LY LOI CHUNG
'========================================
XuLyLoi:
LoiBaoVe = Err.Description
Application.EnableEvents = EventsCu
Application.ScreenUpdating = ScreenCu
MsgBox _
"Co loi khi xu ly." & vbCrLf & _
"Sheet: " & TenSheet & vbCrLf & _
"Loi: " & LoiBaoVe, _
vbExclamation, "LOI VBA"
End Sub
Macro trên sau khi khóa vẫn:
Cụ thể:
- Nếu còn ít nhất một sheet chưa khóa, macro sẽ chuyển sang chế độ khóa.
- Nếu tất cả sheet đều đã khóa, macro sẽ chuyển sang chế độ mở khóa.
Khi khóa, macro sẽ:
- tìm các ô có công thức trong từng sheet;
- đặt thuộc tính ẩn công thức để người dùng không nhìn thấy công thức trên thanh Formula;
- khóa sheet bằng mật khẩu
0943836131; - vẫn cho phép dùng Filter và PivotTable/PivotChart;
- nếu sheet đã khóa từ trước, macro sẽ thử kiểm tra xem có dùng đúng mật khẩu
0943836131hay không; - nếu dùng mật khẩu khác, macro ghi lại tên sheet đó để báo cuối cùng.
Khi mở khóa, macro sẽ:
- thử mở từng sheet bằng mật khẩu
0943836131; - sheet mở được thì hiện lại công thức;
- sheet không mở được thì giữ nguyên;
- ghi lại tên cụ thể các sheet đang dùng mật khẩu khác.
Cuối mỗi lần chạy, macro sẽ báo:
- số sheet đã khóa mới hoặc đã mở;
- số sheet bị bỏ qua;
- danh sách sheet dùng mật khẩu khác;
- trạng thái Filter và PivotTable vẫn được giữ.
Nói ngắn gọn, đây là macro kiểu:
1 nút bấm để khóa/mở toàn bộ workbook + ẩn/hiện công thức + giữ Filter/Pivot + phát hiện sheet có mật khẩu khác.
Một lưu ý: để kiểm tra một sheet đã khóa từ trước có đúng mật khẩu 0943836131 hay không, macro phải thử mở khóa rồi khóa lại ngay. Excel không có lệnh đọc trực tiếp mật khẩu bảo vệ sheet.
Bạn đổi: MatKhau = "0943836131" thành Mật khẩu Bạn muốn
Bước 4 — Lưu PERSONAL.XLSB
Nhấn Ctrl + S.
Sau đó đóng Excel. Nếu Excel hỏi có muốn lưu thay đổi đối với
Personal Macro Workbook thì chọn Save/Lưu.
Bước 5 — Đưa 2 nút lên thanh công cụ
Mở lại Excel.
Vào:
Tệp → Tùy chọn → Thanh công cụ Truy nhập Nhanh
Ở Chọn lệnh từ, chọn:
Macro
Bạn sẽ thấy:
PERSONAL.XLSB!KhoaTatCaSheet
PERSONAL.XLSB!MoKhoaTatCaSheet
Thêm cả hai sang bên phải.
Bạn có thể chọn Sửa đổi/Modify để đổi biểu tượng cho dễ nhận
biết.
Sau này thao tác chỉ còn:
Mở file Excel → bấm nút Khóa → xong.
Khi cần sửa dữ liệu:
Bấm nút Mở khóa → xong.
Muốn sửa Macro cũ bấm Alt + F11 , sửa
xong nhớ bấm Ctrl + S
Sau đó có thể nhấn Alt + F11 để quay lại Excel. tắt Excel và
Save
Cách gán phím tắt
Trong Excel:
1. Nhấn Alt + F8 để mở danh sách Macro.
2. Chọn macro:
PERSONAL.XLSB!KhoaTatCaSheet
3. Bấm Options... / Tùy chọn...
Macro VBA trong Excel dùng để ẩn/hiện các dòng dựa trên dữ liệu ở cột G đến P, bắt đầu từ dòng 5
Sub AnBoAnDongTrong_G_P()
Dim ws As Worksheet
Dim lastRow As Long
Dim r As Long
Dim c As Range
Dim CoDuLieu As Boolean
Dim CoDongDangAn As Boolean
Dim DangKhoa As Boolean
Dim MatKhau As String
MatKhau = "0943836131"
Set ws = ActiveSheet
If ws.Cells.Find("*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious) Is Nothing Then Exit Sub
lastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo XuLyLoi
'Ghi nho trang thai khoa ban dau
DangKhoa = ws.ProtectContents
'Neu dang khoa thi mo tam
If DangKhoa Then
ws.Unprotect Password:=MatKhau
End If
'Kiem tra xem co dong nao dang bi an hay khong
For r = 5 To lastRow
If ws.Rows(r).Hidden = True Then
CoDongDangAn = True
Exit For
End If
Next r
If CoDongDangAn Then
'Bo an tat ca cac dong
ws.Rows("5:" & lastRow).Hidden = False
Else
'An dong neu tat ca cac o G:P deu trong
For r = 5 To lastRow
CoDuLieu = False
For Each c In ws.Range("G" & r & ":P" & r)
'Cong thuc tra ve "" cung duoc coi la trong
If Len(Trim(CStr(c.Value))) > 0 Then
CoDuLieu = True
Exit For
End If
Next c
If CoDuLieu = False Then
ws.Rows(r).Hidden = True
End If
Next r
End If
'Neu ban dau dang khoa thi khoa lai
If DangKhoa Then
ws.Protect _
Password:=MatKhau, _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
XuLyLoi:
'Neu co loi ma sheet da bi mo khoa thi co gang khoa lai
On Error Resume Next
If DangKhoa And ws.ProtectContents = False Then
ws.Protect _
Password:=MatKhau, _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox _
"Co loi khi an/bo an dong." & vbCrLf & _
"Sheet: " & ws.Name & vbCrLf & _
"Loi: " & Err.Description, _
vbExclamation, "LOI"
End Sub
