Macro khóa và mở trong excel - CÁ CẢNH QUỐC AN
Home thủ thuật Macro khóa và mở trong excel

Macro khóa và mở trong excel

Macro khóa và mở trong excel
Comment
Ads Code

____________________________________________ 

Sub KhoaMoTatCaSheet()


    Dim ws As Worksheet

    Dim MatKhau As String

    Dim DangKhoa As Boolean


    MatKhau = "123456"


    'Kiểm tra sheet hiện tại đang khóa hay chưa

    DangKhoa = ActiveSheet.ProtectContents


    Application.ScreenUpdating = False


    If DangKhoa = True Then


        'Đang khóa -> mở khóa tất cả sheet

        For Each ws In ActiveWorkbook.Worksheets

            ws.Unprotect Password:=MatKhau

        Next ws


        MsgBox "Đã MỞ KHÓA tất cả " & ActiveWorkbook.Worksheets.Count & " sheet.", _

               vbInformation, "Mở khóa"


    Else


        'Đang mở -> khóa tất cả sheet

        For Each ws In ActiveWorkbook.Worksheets


            ws.Protect _

                Password:=MatKhau, _

                AllowFiltering:=True, _

                AllowUsingPivotTables:=True


        Next ws


        MsgBox "Đã KHÓA tất cả " & ActiveWorkbook.Worksheets.Count & " sheet." & vbCrLf & _

               "Vẫn sử dụng được Bộ lọc và PivotTable.", _

               vbInformation, "Khóa"


    End If


    Application.ScreenUpdating = True


End Sub

_______________________________________________


  • ☑ Sử dụng Bộ lọc Tự động
  • ☑ Sử dụng PivotTable và PivotChart ( vẫn sử dụng bộ lọc)
  • 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...


    • Các bước thực hiện thêm Macro mới 

    Bước 1 — Tạo PERSONAL.XLSB

    Trong Excel 2024:

    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)

    Chọn:

    PERSONAL.XLSB → Insert → Module

    Bước 3 — Dán macro này

    Tôi khuyên dùng phiên bản dưới đây thay vì macro trước, vì nó tác động vào file Excel đang mở/đang chọn, chứ không khóa PERSONAL.XLSB. ( dán Macro phía trên cùng vào)

    Bạn đổi:

    123456

    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.


    ___________________________
    Macro 

    Bản không phụ thuộc vào sheet bạn đang đứng. Macro sẽ tự kiểm tra toàn bộ workbook:

    • Nếu còn ít nhất 1 sheet chưa khóa → hiểu là bạn muốn KHÓA → chỉ khóa các sheet chưa khóa.
    • Nếu tất cả sheet đều đang khóa → hiểu là bạn muốn MỞ → chỉ mở những sheet có đúng mật khẩu của macro.
    • Sheet khóa bằng mật khẩu khác → giữ nguyên.
    • Khi khóa vẫn cho phép Bộ lọc tự động và PivotTable/PivotChart.
    • Chỉ cần 1 macro + 1 phím tắt.
    • khi khóa thì ẩn công thức
    • __________
    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 = "123456"

        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


    Ads Code
    Ads Code
    Related Posts
    autorelaxed disini
    Disqus Comment
    Đăng ký: Đăng Nhận xét (Atom)

    Quảng cáo

    Quảng cáo

    Liên hệ