Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Gỡ password protect sheet bằng VBA
30-12-11, 04:28 PM
Bài viết: #1
Gỡ password protect sheet bằng VBA
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]
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]
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]

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

Chữ Ký của Noname020
ღღღღღTài sản của Noname (View All Items) ღღღღღ
Trả lời
 Những người đã cảm ơn dannynguyen1980 , Hạ Vàng , darkmoon , haquocquan
31-12-11, 11:32 AM
Bài viết: #2
RE: Gỡ password protect sheet bằng VBA
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

Chữ Ký của darkmoonXin chào, mình là darkmoon, Tham gia http://thuthuataccess.com/forum từ ngày 06-07 -11.
Trả lời
 Những người đã cảm ơn haquocquan , Hạ Vàng , Noname

Tags: Gỡ, password, protect, sheet, bằng,

Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  Tạo trình chơi nhạc trên Excel bằng WMP của Windows(WMP cũ) Xuân Thanh 0 595 11-05-13 03:17 PM
Bài mới nhất: Xuân Thanh
  Lập Phiếu Thu-Chi bằng Excel Noname 39 36,389 28-03-13 11:09 AM
Bài mới nhất: ngothingakt
  [help] Toán thống kê ước lượng bằng excel assyrian19 0 1,058 15-04-12 08:49 PM
Bài mới nhất: assyrian19
  [Giáo Trình]Phân tích Thống kê bằng Excel Noname 0 1,922 13-02-12 04:34 PM
Bài mới nhất: Noname

Chuyển nhanh:


Thành viên đang đọc chủ đề: 1 Khách

Liên hệ | Thủ Thuật Access | Lên trên | Nội dung | Bản rút gọn | Tin RSS