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
MatKhau = "0943836131"
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo
XuLyLoi
'========================================
' 1. KIỂM TRA TOÀN
BỘ WORKBOOK
' Còn ít nhất 1
sheet chưa khóa -> KHÓA
' Tất cả sheet đã
khóa -> MỞ
'========================================
CoSheetChuaKhoa =
False
For Each ws In
ActiveWorkbook.Worksheets
If
ws.ProtectContents = False Then
CoSheetChuaKhoa = True
Exit For
End If
Next ws
'========================================
' 2. CHẾ ĐỘ KHÓA
'========================================
If CoSheetChuaKhoa
= True Then
For Each ws In
ActiveWorkbook.Worksheets
'Chỉ xử lý
sheet chưa khóa
If
ws.ProtectContents = False Then
'----------------------------------------
' Chỉ ẩn
các ô thực sự có công thức
'----------------------------------------
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
'----------------------------------------
' Khóa
sheet
' Vẫn
cho phép Filter + PivotTable
'----------------------------------------
ws.Protect _
Password:=MatKhau, _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
SoSheetXuLy = SoSheetXuLy + 1
Else
'Sheet
đã khóa từ trước -> giữ nguyên
SoSheetBoQua = SoSheetBoQua + 1
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox _
"ĐÃ
KHÓA VÀ ẨN CÔNG THỨC" & vbCrLf & vbCrLf & _
"Khóa
mới: " & SoSheetXuLy & " sheet" & vbCrLf & _
"Đã
khóa từ trước, giữ nguyên: " & SoSheetBoQua & " sheet"
& vbCrLf & vbCrLf & _
"Vẫn
sử dụng được:" & vbCrLf & _
"- Bộ
lọc tự động" & vbCrLf & _
"-
PivotTable / PivotChart", _
vbInformation, "KHÓA SHEET"
'========================================
' 3. CHẾ ĐỘ MỞ
'========================================
Else
For Each ws In
ActiveWorkbook.Worksheets
If
ws.ProtectContents = True Then
Err.Clear
On
Error Resume Next
'Chỉ
sheet đúng mật khẩu mới mở được
ws.Unprotect Password:=MatKhau
If
Err.Number = 0 And ws.ProtectContents = False Then
'----------------------------------------
'
Hiện lại công thức của sheet vừa mở
'----------------------------------------
Set rngFormula = Nothing
Set rngFormula = _
ws.UsedRange.SpecialCells(xlCellTypeFormulas)
If
Not rngFormula Is Nothing Then
rngFormula.FormulaHidden = False
End If
SoSheetXuLy = SoSheetXuLy + 1
Else
'Mật
khẩu khác -> giữ nguyên
SoSheetBoQua = SoSheetBoQua + 1
End If
Err.Clear
On
Error GoTo XuLyLoi
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox _
"ĐÃ MỞ
CÁC SHEET ĐÚNG MẬT KHẨU" & vbCrLf & vbCrLf & _
"Đã mở:
" & SoSheetXuLy & " sheet" & vbCrLf & _
"Mật
khẩu khác, giữ nguyên: " & SoSheetBoQua & " sheet", _
vbInformation, "MỞ KHÓA SHEET"
End If
Exit Sub
'========================================
' 4. XỬ LÝ LỖI
'========================================
XuLyLoi:
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox _
"Có lỗi
khi xử lý." & vbCrLf & _
"Sheet:
" & ws.Name & vbCrLf & _
"Lỗi: " & Err.Description, _
vbExclamation, "LỖI"
End Sub
Macro trên sau khi khóa vẫn: ☑ Sử dụng Bộ lọc Tự động
☑ Sử dụng PivotTable và PivotChart ( vẫn sử dụng bộ lọc)
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
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
'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
Application.ScreenUpdating = True
End Sub
