برداشتن پسورد و پروتکشن(PROTECTION) از فایل اکسل!

لطفا مطلب برداشتن پسورد و پروتکشن اکسل را تا انتها بخوانید! 

با سلام خدمت دوستان عزیز وب سایت کاربلدها. 

این هم یک روش عالی و بی نظیر برای برداشتن پسورد و پروتکشن از روی فایل اکسل بدون استفاده از نرم افزار و جالبه بدونید که ما انواع نرم افزارهای مختلف حذف پسورد اکسل از سطر و ستون های فایل رو امتحان کردیم و هرکدوم به نوعی داستان خودشون رو دارند و کار نمی کنند اما Macro قطعا کار شما رو راه می اندازه و برداشتن پسورد و پروتکشن برای شما یک کار 1 دقیقه ای ساده میشه!

اما روش کار با ماکرو برای دوستانی که آشنایی چندانی با اکسل ندارند، ابتدا فایل اکسلی که رمزگذاری شده را باز کنید و بعد مراحل زیر را دنبال کنید:

views –> Macros –> record Macro

و record macro رو انتخاب کنید و نامی را به ماکروتون اختصاص بدین و بعد دکمه ok رو فشار بدین . حالا دوباره از منوی view و macros گزینه view macros رو فشار بدین و stop recording  رو انتخاب کنید . دوباره ازمسیر قبل view macros  رو انتخاب کرده و اسم ماکرویی رو که درست کرده بودین رو پیدا کنید و دکمه edit رو فشار بدین .
حالا جای متن ماکرو متن زیر رو جایگزین کنید :

Option Explicit

Sub UnlockLegacyExcel()
‘ Breaks worksheet and workbook structure passwords (Legacy .xls files only)
‘ Based on Bob McCormick & Jason S algorithm

Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & “Adapted from Bob McCormick base code by Jason S”
Const HEADER As String = “AllInternalPasswords User Message”
Const VERSION As String = DBLSPACE & “Version 1.0 8 Sep 2008”
Const REPBACK As String = DBLSPACE & “Legacy Hash Collision Solver”
Const ALLCLEAR As String = DBLSPACE & “The workbook should be cleared”

Const MSGNOPWORDS1 As String = “There were no passwords on ” & AUTHORS & VERSION
Const MSGNOPWORDS2 As String = “There was no protection to workbook structure or windows.” & DBLSPACE
Const MSGTAKETIME As String = “After pressing OK button this will take some time.” & DBLSPACE & “Checking hash collisions…”
Const MSGPWORDFOUND1 As String = “Found Workbook Structure/Windows equivalent password: ” & DBLSPACE & “$$” & AUTHORS & VERSION
Const MSGPWORDFOUND2 As String = “Found Worksheet password equivalent: ” & DBLSPACE & “$$” & AUTHORS & VERSION
Const MSGONLYONE As String = “Only structure/windows protected with the password that was just found.” & ALLCLEAR & AUTHORS & VERSION

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 WinTag Then
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
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 Not ActiveWorkbook.ProtectStructure And Not ActiveWorkbook.ProtectWindows 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 Replace(MSGPWORDFOUND1, “$$”, PWord1), vbInformation, HEADER
GoTo WorkbookUnlocked
End If
Next n: Next i6: Next i5: Next i4: Next i3: Next i2
Next i1: Next m: Next l: Next k: Next j: Next i
WorkbookUnlocked:
On Error GoTo 0
Else
MsgBox MSGNOPWORDS2, vbInformation, HEADER
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
If PWord1 <> “” Then w1.Unprotect PWord1
Next w1
On Error GoTo 0

For Each w1 In Worksheets
If w1.ProtectContents Then
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
w1.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 w1.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 Replace(MSGPWORDFOUND2, “$$”, PWord1), vbInformation, HEADER
‘ تست پسورد یافت‌شده روی بقیه شیت‌ها
For Each w2 In Worksheets
w2.Unprotect PWord1
Next w2
GoTo NextSheetLoop
End If
Next n: Next i6: Next i5: Next i4: Next i3: Next i2
Next i1: Next m: Next l: Next k: Next j: Next i
NextSheetLoop:
On Error GoTo 0
End If
Next w1

Application.ScreenUpdating = True
MsgBox ALLCLEAR & AUTHORS & VERSION, vbInformation, HEADER
End Sub

  در نهایت گزینه run  یا دکمه F5 کیبورد رو فشار بدین تا ماکرو اجرا بشه و یه چند ثانیه صبر کنید تا ماکرو عمل کنه… دقت کنید حدود 20 ثانیه طول میکشه و تمام …برداشتن پسورد و پروتکشن انجام شد!

راهکار برای فایل‌های مدرن (.xlsx و .xlsm):

اگر فایل شما با اکسل‌های جدید محافظت شده است، روش استاندارد و بدون نیاز به کرک این است:

1. پسوند فایل را از .xlsx به .zip تغییر دهید.
2. آرشیو را باز کرده و به مسیر xl/worksheets/ بروید.
3. فایل XML شیت مورد نظر (مانند sheet1.xml) را باز کرده و تگ <sheetProtection ... /> را به طور کامل حذف و فایل را ذخیره کنید.
4. پسوند را مجدداً به .xlsx برگردانید.