Cara Menghapus Password Worksheet Dengan Macro

Cara Menghapus Password Worksheet Dengan Macro - Banyak aplikasi excel yang beredar di internet yang dapat sobat download terkadang susah untuk mengedit file tersebut karena terproteksi oleh password. Dalam postingan kali ini saya akan mengulas sedikit bagaimana cara menghapus password worksheet dengan macro.

Sebenarnya banyak software atau aplikasi yang dapat menghapus password pada worksheet, akan tetapi memerlukan waktu untuk mendownload software tersebut terlebih kebanyakan aplikasi tersebut tak mampu menemukan password bahkan menghapusnya. Untuk cara ini sobat tak perlu mahir menggunakan kode-kode visual basic akan tetapi cukup mengikuti langkah-langkah berikut ini:

1. Buka File Excel, kemudian nantinya akan muncul Security Warning pada bagian atas formula bar, klik Option, kemudian pilih Enable this content, perhatikan gambar berikut:

2. Pilih menu Review kemudian klik Unprotect sheet, di sini kita diminta untuk memasukkan password. Kalau passwordnya tidak tau jangan diisi.

3. Kemudian tekan kombinasi keyboard Alt+F11 untuk memunculkan jendela Microsoft Visual Basic, perhatikan gambar berikut:

4. Pilih Insert kemudian pilih Module seperti gambar berikut ini:

5. Kemudian klik 2X Module hingga muncul jendela dimana nantinya kita akan menuliskan kode visual basic. Berikut kode visual basicnya:
Sub antiproteksi()

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

'Attempt clearance with PWord1

w1.Unprotect PWord1

Next w1

On Error GoTo 0

ShTag = False

For Each w1 In Worksheets

'Checks for all clear ShTag triggered to 1 if not.

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

'leverage finding Pword by trying on other sheets

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
Copy kode diatas kemudian pastekan pada jendela module tadi, kemudian jalankan. Perhatikan gambar berikut ini:

6. Tunggu beberapa saat hingga muncul perintah seperti gambar berikut, lalu klik OK saja dan tunggu beberapa saat:

7. Tahap selanjutnya tutup jendela Microsoft Visual Basic, kemudian klik Protect sheet maka password akan hilang. Untuk membuat permanen tanpa password ikuti gambar berikut:


Bagaimana, sangat mudah bukan? Sekian, semoga bermanfaat.

Related Posts →


Open Disqus Close Disqus

This site uses cookies from Google to deliver its services, to personalise ads and to analyse traffic. Information about your use of this site is shared with Google. By using this site, you agree to its use of cookies. Blogger Cookies