Menghapus Password Sheet Dengan VBA

Sesuai dengan judul di atas, tutorial kali ini berisi tentang bagaimana caranya menghapus atau menghilangkan sheet dalam Microsoft Excel yang di kunci alias di beri password TANPA menggunakan tools atau software lain, dengan catatan; Jendela VBA Editor tidak dalam keadaan terkunci, karena jika dalam keadaan terkunci, maka kode VBA di bawah ini tidak akan bisa dimasukkan... Untuk membuka kunci (Password) yang ada dalam Sheet Microsoft Excel, langkahnya

• Buka jendela VBA Editor dengan cara tekan tombol ALT + F11 di keyboard Anda.
• Selanjutnya adalah membuat sebuah module; Klik Insert -> Modules
• Setelah Anda selesai membuat module baru, tempelkan kode berikut ini di dalamnya.
  
  Sub Password()
  Const DBLSPACE As String = vbNewLine & vbNewLine
  Const AUTHORS As String = DBLSPACE & "re-edit by rumahexcel.com"
  Const HEADER As String = "Internal Password Remover"
  Const VERSION As String = vbNewLine & "version 1.7 (25 feb 2013)"
  Const REPBACK As String = DBLSPACE & "Please report failure to admin@rumahexcel.com"
  Const ALLCLEAR As String = DBLSPACE & "The workbook should be cleared, thanks for your patience"
  Const MSGNOPWORDS1 As String = "There were no passwords on your worksheet" & AUTHORS & VERSION
  Const MSGNOPWORDS2 As String = "Please wait while the code working ...." & DBLSPACE
  Const MSGTAKETIME As String = "After pressing OK button this " & "will " & _
  "take some time." & DBLSPACE & "Amount of time " & "depends on how many " & _
  "different passwords on your workbook "
  Const MSGPWORDFOUND1 As String = "You had a Worksheet " & "Structure or" & _
  "Windows Password set." & DBLSPACE & "The password found was: " & _
  DBLSPACE & "$$" & DBLSPACE & "Note it down for potential future use in" & _
  "other workbooks by " & "the same person who set this password." & _
  DBLSPACE & "Now to check and clear other passwords." & AUTHORS & VERSION
  Const MSGPWORDFOUND2 As String = "You had a Worksheet " & "password" & _
  "set." & DBLSPACE & "The password found was: " & DBLSPACE & "$$" & _
  DBLSPACE & "Note it down for potential " & "future use in other" & _
  "workbooks by same person who " & "set this password." & DBLSPACE & "Now" & _
  "to check and clear " & "other passwords." & AUTHORS & VERSION
  Const MSGONLYONE As String = "Only structure / windows " & "protected" & _
  "with the password that was just found." & ALLCLEAR & AUTHORS & VERSION & _
  REPBACK
  Dim w1 As Worksheet, w2 As Worksheet
  Dim i As Integer, j As Integer, k As Integer, l As Integer
  Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
  Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
  Dim PWord1 As String
  Dim ShTag As Boolean, WinTag As Boolean
  
  Application.ScreenUpdating = False
  With ActiveWorkbook
  WinTag = .ProtectStructure Or .ProtectWindows
  End With
  ShTag = False
  For Each w1 In Worksheets
  ShTag = ShTag Or w1.ProtectContents
  Next w1
  If Not ShTag And Not WinTag Then
  MsgBox MSGNOPWORDS1, vbInformation, HEADER
  Exit Sub
  End If
  MsgBox MSGTAKETIME, vbInformation, HEADER
  If Not WinTag Then
  MsgBox MSGNOPWORDS2, vbInformation, HEADER
  Else
  
  On Error Resume Next
  Do 'dummy do loop
  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
  
  With ActiveWorkbook
  .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 .ProtectStructure = False And .ProtectWindows = False Then
  PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
  Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
  MsgBox Application.Substitute(MSGPWORDFOUND1, "$$", PWord1) & _
  vbInformation, HEADER
  
  Exit Do 'Bypass all for...nexts
  End If
  End With
  
  Next: Next: Next: Next: Next: Next
  Next: Next: Next: Next: Next: Next
  
  Loop Until True
  
  On Error GoTo 0
  End If
  
  If WinTag And Not ShTag Then
  MsgBox MSGONLYONE, vbInformation, HEADER
  Exit Sub
  End If
  
  On Error Resume Next
  For Each w1 In Worksheets
  
  w1.Unprotect PWord1
  Next w1
  On Error GoTo 0
  ShTag = False
  For Each w1 In Worksheets
  
  ShTag = ShTag Or w1.ProtectContents
  Next w1
  
  If ShTag Then
  For Each w1 In Worksheets
  With w1
  
  If .ProtectContents Then
  On Error Resume Next
  Do 'Dummy do loop
  
  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
  
  .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 Not .ProtectContents Then
  
  PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
  Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
  
  MsgBox Application.Substitute(MSGPWORDFOUND2, "$$", PWord1) & _
  vbInformation, HEADER
  
  For Each w2 In Worksheets
  w2.Unprotect PWord1
  Next w2
  Exit Do 'Bypass all for...nexts
  End If
  Next: Next: Next: Next: Next: Next
  Next: Next: Next: Next: Next: Next
  Loop Until True
  On Error GoTo 0
  
  End If
  End With
  
  Next w1
  End If
  
  MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
  End Sub
  
• Setelah Anda memasukkan kode di atas, tekan F5 di keyboard Anda untuk menjalankan kode
• Jika kode berhasil, akan menampilkan sebuah pesan bahwa sheet sudah berhasil di buka

Selamat Mencoba...

Sumber Informasi :