Tùy chọn
Gỡ password protect sheet bằng VBA
- Gỡ password protect sheet bằng VBA
-
Gỡ password protect sheet bằng VBA
Noname > 30-12-11, 05:28 PM
Cách làm trong Excel 2007/2010 như sau: bấm Alt + F11 để hiện ra bảng Visual Basic Editor rồi sau đó thực hiện theo bước 3 như phía dưới.
Cách làm trong Excel 2003 như sau:
1. Mở file Excel có chứa các Sheet có pass
2 Chọn menu Tools -> Macro -> Visual Basic Editor
3 Nhấp đúp vào Sheet mà bạn muốn phá pass
Nếu bạn chưa thấy các Sheet bên phía trái của màn hình thì bấm: Ctrl + R để hiện các Sheet.
( Nhiều máy khi bấm Alt + F11 thì không thấy cửa sổ bên trái hiện các Sheet )
4. Copy đoạn mã sau vào và nhấn menu Run -> Run Sub/UserForm
![[Hình: Capture_2.jpg]](http://tranhung.vnweblogs.com/gallery/21/previews-med/Capture_2.jpg)
5. Máy hỏi bạn có muốn CHƠI nó không ? Nếu muốn bấm YES
![[Hình: Capture1.jpg]](http://tranhung.vnweblogs.com/gallery/21/previews-med/Capture1.jpg)
6. Bạn chờ một lúc máy sẽ phá Pass cho bạn. Có thông báo sau khi phá Pass
![[Hình: Capture_3.jpg]](http://tranhung.vnweblogs.com/gallery/21/previews-med/Capture_3.jpg)
Sao mà ghét cái thằng nào nó . . . không muốn chia sẻ thông tin cho người khác ghê.
Mã: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
Nguồn: http://tranhung.vnweblogs.com -
RE: Gỡ password protect sheet bằng VBA
darkmoon > 31-12-11, 12:32 PM
Quá tuyệt. Đoạn code ngắn gọn, dễ hiểu.
Lúc trước cũng có một đoạn code trên internet dùng để unprotect sheet, unprotect workbook. Nay chia sẻ lại với các bạn:
Mã:Option Explicit
Const tekstBook As String = "This workbook should now be unprotected."
Const tekstSheet As String = "This sheet should now be unprotected."
Const progName As String = "Password remover"
Const payText As String = "If you want to thank me for this program, donations can be given at my website www.straxx.com, and will be highly appreciated."
Const payText2 As String = "Major credit cards are accepted."
Const meText As String = "Einar Ståle Huse"
Const lower As Integer = 32
Const lower1 As Integer = 65
Const lower2 As Integer = 66
Const upper As Integer = 255
Public Const maxYear As Integer = 2200
Sub Auto_Open()
Dim mb As Object
Dim mi As Object
On Error Resume Next
If Year(Now) > maxYear Then
MsgBox ("This version of """ & progName & """ has expired." & Chr(13) & Chr(13) & "To get a newer version check out:" & Chr(13) & "http://www.straxx.com/excel/password.html")
Application.DisplayAlerts = False
ThisWorkbook.Close
Exit Sub
End If
Call Auto_Close
For Each mb In MenuBars
With mb.Menus("Tools")
Call .MenuItems.Add("Unprotect sheet", "UnprotectSheet")
Call .MenuItems.Add("Unprotect workbook", "UnprotectWorkBook")
End With
Next
Call MsgBox(progName & " now loaded." & Chr(13) & Chr(13) & "Choose 'Unprotect workbook' on the 'Tools'-menu to unprotect workbook." & Chr(13) & "Choose 'Unprotect sheet' on the 'Tools'-menu to unprotect sheet." & Chr(13), vbOKOnly + vbInformation, progName & " http://www.straxx.com")
End Sub
Sub Auto_Close()
Dim mi As Object
Dim mb As Object
On Error Resume Next
For Each mb In MenuBars
For Each mi In mb.Menus("Tools").MenuItems
If mi.Caption = "Unprotect workbook" Or mi.Caption = "Unprotect sheet" Then
mi.Delete
End If
Next
Next
End Sub
Sub UnprotectWorkBook()
'Finner arbeidsbokpassord
Dim funnet As Boolean: Dim tekst As String
Dim i As Integer: Dim j As Integer: Dim k As Integer: Dim l As Integer
Dim m As Integer: Dim n As Integer: Dim o As Integer: Dim p As Integer
Dim gmlStatusLinje As Variant: Dim gmlTid As Variant
Dim oldCalculation As Integer
On Error Resume Next
If Year(Now) > maxYear Then
MsgBox ("This version of """ & progName & """ has expired." & Chr(13) & Chr(13) & "To get a newer version check out:" & Chr(13) & "http://www.straxx.com/excel/password.html")
Exit Sub
End If
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
oldCalculation = Application.Calculation
Application.Calculation = xlManual
Application.ScreenUpdating = False
gmlStatusLinje = Application.DisplayStatusBar
Application.DisplayStatusBar = True
gmlTid = Now()
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
ActiveWorkbook.Unprotect
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If Not funnet Then
For i = lower To upper
tekst = Chr(i)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If Not funnet Then
For i = lower1 To lower2
For j = lower To upper
tekst = Chr(i) + Chr(j)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
End If
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2
For k = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2
For l = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2
For m = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2: For m = lower1 To lower2
For n = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m) + Chr(n)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2: For m = lower1 To lower2: For n = lower1 To lower2
For o = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m) + Chr(n) + Chr(o)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2
For m = lower1 To lower2: For n = lower1 To lower2: For o = lower1 To lower2
For p = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m) + Chr(n) + Chr(o) + Chr(p)
ActiveWorkbook.Unprotect (tekst)
funnet = Not (ActiveWorkbook.ProtectStructure Or ActiveWorkbook.ProtectWindows)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
Application.ScreenUpdating = True
Call MsgBox(tekstBook & " Time: " & Format(Now() - gmlTid, "hh.mm.ss") & Chr(13) & Chr(13) & payText & Chr(13) & payText2 & Chr(13) & Chr(13) & meText & Chr(13) & "password@straxx.com", vbOKOnly + vbInformation, progName & " http://www.straxx.com")
Application.StatusBar = False
Application.DisplayStatusBar = gmlStatusLinje
Application.Calculation = oldCalculation
End Sub
Sub UnprotectSheet()
'Finner arkpassord
Dim funnet As Boolean: Dim tekst As String
Dim i As Integer: Dim j As Integer: Dim k As Integer
Dim l As Integer: Dim m As Integer: Dim n As Integer: Dim o As Integer: Dim p As Integer
Dim gmlStatusLinje As Variant: Dim gmlTid As Variant
Dim oldCalculation As Integer
On Error Resume Next
If Year(Now) > maxYear Then
MsgBox ("This version of """ & progName & """ has expired." & Chr(13) & Chr(13) & "To get a newer version check out:" & Chr(13) & "http://www.straxx.com/excel/password.html")
Exit Sub
End If
oldCalculation = Application.Calculation
Application.Calculation = xlManual
Application.ScreenUpdating = False
gmlStatusLinje = Application.DisplayStatusBar
Application.DisplayStatusBar = True
gmlTid = Now()
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
ActiveSheet.Protect ("")
funnet = ActiveSheet.Unprotect("")
If Not funnet Then
For i = lower To upper
tekst = Chr(i)
funnet = ActiveSheet.Unprotect(tekst)
If funnet Then Exit For
Next
End If
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If Not funnet Then
For i = lower1 To lower2
For j = lower To upper
tekst = Chr(i) + Chr(j)
funnet = ActiveSheet.Unprotect(tekst)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2
For k = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k)
funnet = ActiveSheet.Unprotect(tekst)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2
For l = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l)
funnet = ActiveSheet.Unprotect(tekst)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2
For m = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m)
funnet = ActiveSheet.Unprotect(tekst)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2: For m = lower1 To lower2
For n = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m) + Chr(n)
funnet = ActiveSheet.Unprotect(tekst)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2: For m = lower1 To lower2: For n = lower1 To lower2
For o = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m) + Chr(n) + Chr(o)
funnet = ActiveSheet.Unprotect(tekst)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
If Not funnet Then
For i = lower1 To lower2: For j = lower1 To lower2: For k = lower1 To lower2: For l = lower1 To lower2
For m = lower1 To lower2: For n = lower1 To lower2: For o = lower1 To lower2
For p = lower To upper
tekst = Chr(i) + Chr(j) + Chr(k) + Chr(l) + Chr(m) + Chr(n) + Chr(o) + Chr(p)
funnet = ActiveSheet.Unprotect(tekst)
If funnet Then Exit For
Next
Application.StatusBar = Format(Now() - gmlTid, "hh.mm.ss")
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
If funnet Then Exit For
Next
End If
Application.ScreenUpdating = True
Call MsgBox(tekstSheet & " Time: " & Format(Now() - gmlTid, "hh.mm.ss") & Chr(13) & Chr(13) & payText & Chr(13) & payText2 & Chr(13) & Chr(13) & meText & Chr(13) & "password@straxx.com", vbOKOnly + vbInformation, progName & " http://www.straxx.com")
Application.StatusBar = False
Application.DisplayStatusBar = gmlStatusLinje
Application.Calculation = oldCalculation
End Sub -
RE: Gỡ password protect sheet bằng VBA
thanhthu > 13-11-16, 12:49 AM
code unprotect workbook không chạy được bạn ơi.