Mở khóa Sheet bằng VBA

Liên hệ QC

Ngoc Hang Truong

Thành viên mới
Tham gia
23/9/20
Bài viết
2
Được thích
0
Chào các anh/chị
Trước giờ em hay mở khóa file excel bằng code VBA (do file em làm thường xuất trên phần mềm xuống và bị đặt khóa để không cho chỉnh sửa), mở rất nhanh chỉ 1,2s là xong nhưng hôm nay em vẫn xài code đó, vẫn file dạng đó thì file bị đứng luôn và không chạy được. Em đã thử qua nhiều máy tính vẫn không chạy được. Xin được anh/chị chỉ giáo. Em cảm ơn nhiều ạ
Code em dùng:
Sub PasswordBreaker()
If ActiveSheet.ProtectContents = False Then
MsgBox "Sheet '" & ActiveSheet.Name & "' is unprotected!", vbInformation
Else
If MsgBox("Sheet '" & ActiveSheet.Name & "' is protected, do you want to unprotect it?", _
vbYesNo + vbQuestion, "Unprotect Active Sheet") = vbNo Then Exit Sub
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)
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
If ActiveSheet.ProtectContents = False Then MsgBox "Sheet '" & ActiveSheet.Name & "' is unprotected!", vbInformation
End If
End Sub
 
Khả năng code này chỉ hoạt động với phiên bản Excel cũ. Phiên bản mới họ đã update về bảo mật nên có thể không thực hiện được.
 
Các anh/chị cho em hỏi code Protect sheet, em đang dùng code dưới để Unprotect sheet nhưnng chỉ Unprotect sheet của ActiveSheet, giờ em muốn tất các sheet đều Unprotect. trong workbook có nhiều sheet mà cứ mỗi lần chuyển sheet để UnProtect thì mất thời gian quá.
Code em đang dùng:
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
Em xin chân thành cảm ơn!
 
UnProtect thì mất thời gian quá.
Mã:
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
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
End Sub
Nếu thông báo mật khẩu mới lặp lại nhiều lần bạn không muốn nhấn enter nhiều lần thì có thể bỏ dòng lệnh thông báo đó đi
 
Web KT
Back
Top Bottom