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
Sub KhoaMoTatCaSheet()
Dim ws As Worksheet
Dim MatKhau As String
Dim CoSheetChuaKhoa As Boolean
Dim SoSheetXuLy As Long
Dim SoSheetBoQua As Long
Dim rngFormula As Range
Dim DanhSachMatKhauKhac As String
MatKhau = "0943836131"
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo XuLyLoi
'========================================
' 1. KIEM TRA TOAN BO WORKBOOK
' Con it nhat 1 sheet chua khoa -> KHOA
' Tat ca sheet da khoa -> MO
'========================================
CoSheetChuaKhoa = False
For Each ws In ActiveWorkbook.Worksheets
If ws.ProtectContents = False Then
CoSheetChuaKhoa = True
Exit For
End If
Next ws
'========================================
' 2. CHE DO KHOA
'========================================
If CoSheetChuaKhoa = True Then
For Each ws In ActiveWorkbook.Worksheets
'Chi xu ly sheet chua khoa
If ws.ProtectContents = False Then
'----------------------------------------
' Chi an cac o thuc su co cong thuc
'----------------------------------------
Set rngFormula = Nothing
On Error Resume Next
Set rngFormula = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo XuLyLoi
If Not rngFormula Is Nothing Then
rngFormula.FormulaHidden = True
End If
'----------------------------------------
' Khoa sheet
' Van cho phep Filter + PivotTable
'----------------------------------------
ws.Protect _
Password:=MatKhau, _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
SoSheetXuLy = SoSheetXuLy + 1
Else
'Sheet da khoa tu truoc -> thu kiem tra
'co phai dung mat khau nay hay khong
Err.Clear
On Error Resume Next
ws.Unprotect Password:=MatKhau
If Err.Number = 0 And ws.ProtectContents = False Then
'Dung mat khau -> khoa lai ngay
ws.Protect _
Password:=MatKhau, _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
SoSheetBoQua = SoSheetBoQua + 1
Else
'Mat khau khac
DanhSachMatKhauKhac = _
DanhSachMatKhauKhac & vbCrLf & "- " & ws.Name
SoSheetBoQua = SoSheetBoQua + 1
End If
Err.Clear
On Error GoTo XuLyLoi
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox _
"DA KHOA VA AN CONG THUC" & vbCrLf & vbCrLf & _
"Khoa moi: " & SoSheetXuLy & " sheet" & vbCrLf & _
"Da khoa tu truoc, giu nguyen: " & SoSheetBoQua & " sheet" & vbCrLf & vbCrLf & _
IIf(DanhSachMatKhauKhac <> "", _
"Sheet dung mat khau khac:" & vbCrLf & _
DanhSachMatKhauKhac & vbCrLf & vbCrLf, _
"Khong co sheet nao dung mat khau khac." & vbCrLf & vbCrLf) & _
"Van su dung duoc:" & vbCrLf & _
"- Bo loc tu dong" & vbCrLf & _
"- PivotTable / PivotChart", _
vbInformation, "KHOA SHEET"
'========================================
' 3. CHE DO MO
'========================================
Else
For Each ws In ActiveWorkbook.Worksheets
If ws.ProtectContents = True Then
Err.Clear
On Error Resume Next
'Chi sheet dung mat khau moi mo duoc
ws.Unprotect Password:=MatKhau
If Err.Number = 0 And ws.ProtectContents = False Then
'----------------------------------------
' Hien lai cong thuc cua sheet vua mo
'----------------------------------------
Set rngFormula = Nothing
Set rngFormula = _
ws.UsedRange.SpecialCells(xlCellTypeFormulas)
If Not rngFormula Is Nothing Then
rngFormula.FormulaHidden = False
End If
SoSheetXuLy = SoSheetXuLy + 1
Else
'Mat khau khac -> giu nguyen
DanhSachMatKhauKhac = _
DanhSachMatKhauKhac & vbCrLf & "- " & ws.Name
SoSheetBoQua = SoSheetBoQua + 1
End If
Err.Clear
On Error GoTo XuLyLoi
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox _
"DA MO CAC SHEET DUNG MAT KHAU" & vbCrLf & vbCrLf & _
"Da mo: " & SoSheetXuLy & " sheet" & vbCrLf & _
"Mat khau khac, giu nguyen: " & SoSheetBoQua & " sheet" & vbCrLf & vbCrLf & _
IIf(DanhSachMatKhauKhac <> "", _
"Danh sach sheet mat khau khac:" & vbCrLf & _
DanhSachMatKhauKhac, _
"Khong co sheet nao dung mat khau khac."), _
vbInformation, "MO KHOA SHEET"
End If
Exit Sub
'========================================
' 4. XU LY LOI
'========================================
XuLyLoi:
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox _
"Co loi khi xu ly." & vbCrLf & _
"Sheet: " & ws.Name & vbCrLf & _
"Loi: " & Err.Description, _
vbExclamation, "LOI"
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
