unprotect sheet bằng vba

Đôi khi do đặc thù công việc hay tính riêng tư mà ta cần bảo vệ các Sheet trong Excel nhưng lâu ngày quên mất mật khẩu để mở khoá, hay khi được chia sẻ một file excel mà vì lý do nào đó đã được bảo vệ (Protect sheet) mà muốn chỉnh sửa nhưng không có mật khẩu để chỉnh sửa (Unprotect sheet). Trong bài viết này Quốc Bình Blog sẽ hướng dẫn cách UnProtect sheet trong Excel  một cách nhanh chóng bằng VBA.

Bước 1: Mở VBA

Sử dụng Alt + F11 để vào trình chỉnh sửa macro.

Khi vào VBA, nhấp đúp vào sheet bạn cần mở khóa từ danh sách sheet bên trái.

Điều này sẽ mở trang khai báo chung cho trang tính.

Bước 2: copy và paste toàn bộ code sau vào

Copy

Sub PasswordBreaker()

'Breaks worksheet password protection.

Dim i As Integer, j As Integer, k As Integer

Dim l As Integer, m As Integer, n As Integer

Dim i1 As Integer, i2 As Integer, i3 As Integer

Dim i4 As Integer, i5 As Integer, i6 As Integer

On Error Resume Next

For i = 65 To 66: For j = 65 To 66: For k = 65 To 66

For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66

For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66

For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _

Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _

Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

If ActiveSheet.ProtectContents = False Then

MsgBox "Mot mat khau co the su dung la: " & Chr(i) & Chr(j) & _

Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _

Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

Exit Sub

End If

Next: Next: Next: Next: Next: Next

Next: Next: Next: Next: Next: Next

End Sub

Bước 3:

Nhấn phím F5 trên bàn phím hoặc click vào run sub như trong hình dưới.

Một cửa sổ hiện ra bạn chỉ cần click Ok là đã Unprotect sheet thành công.

Để unprotect all sheet thì dùng code sau:

Copy

Option Explicit
Sub Mo_Khoa()
Dim Ws As Worksheet
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
Application.ScreenUpdating = False
For Each Ws In Worksheets
    If Ws.ProtectContents = True Then
            For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
            For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
            For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
            For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
                Ws.Unprotect Chr(i) & Chr(j) & Chr(k) & _
                            Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
                            Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
                If Ws.ProtectContents = False Then
                            'MsgBox "Mot mat khau co the su dung la: " & Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
                            GoTo chuyen
                End If
            Next: Next: Next: Next: Next: Next
            Next: Next: Next: Next: Next: Next
   End If
chuyen:
Next Ws
Application.ScreenUpdating = True
End Sub