إلغاء أى حماية لشيت إكسيل بخطوة واحدة

**Yasser Fathi Albanna** · أكتوبر 30, 2015

السلام عليكم ورحمة الله وبركاته

أحبائى فى الله

أقدم لكم اليوم كود يوضع فى حدث الشيت المراد فك حمايته يقوم بإلغاء الحماية عن الشيت

Sub PasswordBreaker()
    'Breaks worksheet password protection.
    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)
    If ActiveSheet.ProtectContents = False Then
        MsgBox "One usable password is " & Chr(i) & Chr(j) & _
            Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
            Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
         Exit Sub
    End If
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next: Next
End Sub

**ياسر العربى** · أكتوبر 30, 2015

اخي الغالي ياسر

مشكور علي الموضوع المهم خصوصا لمن فقد او نسى

كلمة مرور الخاصة به لشيت معين

بالمثل الكود الذي يقوم بفك حماية اكواد الvba

لمن نسى حماية اكواده داخل اي ملف

ولكن لي نظرة في هذه المواضيع وهي

كثرة استخدام هذه الاكواد في فك حماية ملفات خاصة باشخاص قد تعبت علي برامجها

وسهرت عليها وفي الاخر يجي واحد بكود ويفك الحماية وينسب مثلا الاعمال دي ليه

وهي دي النقطة اللي تجعلنا لا نكثر من مثل هذه المواضيع

لك فائق شكري واحترامي

**عبد العزيز البسكري** · أكتوبر 30, 2015

السّلام عليكم و رحمة الله و بركاته

بارك الله فيك أستاذي الفاضل "ياسر فتحي البنّا" على الكود الرّائع .. فعلاً أحيانا الواحد منّا ينسى كلمة المرور لكثرة الملفات و تغيير كلمات المرور من ملف لملف

جزاك الله خيرًا و زادها بميزان حسناتك .. و زادك من علمه و فضله

فائق إحتراماتي

**Yasser Fathi Albanna** · أكتوبر 30, 2015

اخي الغالي ياسر

مشكور علي الموضوع المهم خصوصا لمن فقد او نسى

كلمة مرور الخاصة به لشيت معين

بالمثل الكود الذي يقوم بفك حماية اكواد الvba

لمن نسى حماية اكواده داخل اي ملف

ولكن لي نظرة في هذه المواضيع وهي

كثرة استخدام هذه الاكواد في فك حماية ملفات خاصة باشخاص قد تعبت علي برامجها

وسهرت عليها وفي الاخر يجي واحد بكود ويفك الحماية وينسب مثلا الاعمال دي ليه

وهي دي النقطة اللي تجعلنا لا نكثر من مثل هذه المواضيع

لك فائق شكري واحترامي

أخى الحبيب / ياسر العربى

يسعدنى مرورك الكريم

نظرتك فى محلها ولكن المقصود من هذه الموضوعات هو بالفعل أنه يوجد الكثير من الأشخاص يفقد او ينسى حماية الشيت بغير قصد

ويتسبب فى عطلة له

فأرجوا من الله أن يستخدم هذا الكود فى الخير ولا لإقتباس أعمال الغير

تقبل خالص تحياتى وتقديرى

السّلام عليكم و رحمة الله و بركاته

بارك الله فيك أستاذي الفاضل "ياسر فتحي البنّا" على الكود الرّائع .. فعلاً أحيانا الواحد منّا ينسى كلمة المرور لكثرة الملفات و تغيير كلمات المرور من ملف لملف

جزاك الله خيرًا و زادها بميزان حسناتك .. و زادك من علمه و فضله

فائق إحتراماتي

يسعدنى ويشرفنى مرورك الكريم دائما على موضوعاتى أخى الحبيب / عبد العزيز السكرى

شكرا لدعائك الطيب وجزيت بمثله

تقبل تحياتى وإحترامى

وائل الاسيوطي · أكتوبر 30, 2015

السلام عليكم ورحمة الله وبركاته

أحبائى فى الله

أقدم لكم اليوم كود يوضع فى حدث الشيت المراد فك حمايته يقوم بإلغاء الحماية عن الشيت

Sub PasswordBreaker()
    'Breaks worksheet password protection.
    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)
    If ActiveSheet.ProtectContents = False Then
        MsgBox "One usable password is " & Chr(i) & Chr(j) & _
            Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
            Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
         Exit Sub
    End If
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next: Next
End Sub

بارك الله فيك اخي ياسر بالفعل هذا الكود مميز استخدمته منذ عامين وفقدته وتعبت حتي حصلت عليه ثانيه

جزاك الله خيرا لتعميمك الفائده

**Yasser Fathi Albanna** · أكتوبر 30, 2015

بوركت أخى الفاضل / وائل الأسيوطى لمرورك العطر

جزيت بمثل ما دعوت به

تقبل تحياتى وتقديرى

**KHMB** · أكتوبر 31, 2015

السلام عليكم ورحمة الله

شكرا م/ ياسر فتحي جزاك الله خير علي رفع مثل هذه الاكواد المندثرة في المنتدى

هذا الكود موجود بالمنتدى قديم جدا ولكن تدويرة وإظهاره للفائده للاخرين .

تم تعديل أكتوبر 31, 2015 بواسطه KHMB

**Yasser Fathi Albanna** · أكتوبر 31, 2015

السلام عليكم ورحمة الله

شكرا م/ ياسر فتحي جزاك الله خير علي رفع مثل هذه الاكواد المندثرة في المنتدى

هذا الكود موجود بالمنتدى قديم جدا ولكن تدويرة وإظهاره للفائده للاخرين .

شكرا جزيلا أخى KHMB

وشكرا لدعائك

**محمد حسن المحمد** · أكتوبر 31, 2015

السلام عليكم أخي الحبيب م / ياسر

جزاكم الله خيراً ...كود ناجح و رائع حقاً...تشكر عليه

نرجو لك دوام التقدم والازدهار..

والسلام عليكم

احمد الحاوي · أكتوبر 31, 2015

السلام عليكم ورحمة الله وبركاته

أحبائى فى الله

أقدم لكم اليوم كود يوضع فى حدث الشيت المراد فك حمايته يقوم بإلغاء الحماية عن الشيت

Sub PasswordBreaker()
    'Breaks worksheet password protection.
    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)
    If ActiveSheet.ProtectContents = False Then
        MsgBox "One usable password is " & Chr(i) & Chr(j) & _
            Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
            Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
         Exit Sub
    End If
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next: Next
End Sub

جزاكم الله خيرا اخي الفاضل .. فعلا كود متميز

تم تعديل أكتوبر 31, 2015 بواسطه احمد الحاوي

**Yasser Fathi Albanna** · أكتوبر 31, 2015

السلام عليكم أخي الحبيب م / ياسر

جزاكم الله خيراً ...كود ناجح و رائع حقاً...تشكر عليه

نرجو لك دوام التقدم والازدهار..

والسلام عليكم

الأستاذ القدير / محمد حسن المحمد

شكرا لمرورك العطر دائما على موضوعاتى وتشجيعك الدائم لى

تقبل خالص تحياتى وتقديرى

السلام عليكم ورحمة الله وبركاته

أحبائى فى الله

أقدم لكم اليوم كود يوضع فى حدث الشيت المراد فك حمايته يقوم بإلغاء الحماية عن الشيت

Sub PasswordBreaker()
    'Breaks worksheet password protection.
    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)
    If ActiveSheet.ProtectContents = False Then
        MsgBox "One usable password is " & Chr(i) & Chr(j) & _
            Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
            Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
         Exit Sub
    End If
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next: Next
End Sub

جزاكم الله خيرا اخي الفاضل .. فعلا كود متميز

شكرا لك أخى الفاضل / أحمد الحاوى

بارك الله فيك

aymnfagr · نوفمبر 4, 2015

السلام عليكم ورحمة الله وبركاته

أحبائى فى الله

أقدم لكم اليوم كود يوضع فى حدث الشيت المراد فك حمايته يقوم بإلغاء الحماية عن الشيت

Sub PasswordBreaker()
    'Breaks worksheet password protection.
    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)
    If ActiveSheet.ProtectContents = False Then
        MsgBox "One usable password is " & Chr(i) & Chr(j) & _
            Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
            Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
         Exit Sub
    End If
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next: Next
End Sub

**الزباري** · نوفمبر 5, 2015

.. جزاك الله خيرا أخي ياسر و زادها بميزان حسناتك وليس غريبا منك هذا الإبداع

**Yasser Fathi Albanna** · نوفمبر 5, 2015

.. جزاك الله خيرا أخي ياسر و زادها بميزان حسناتك وليس غريبا منك هذا الإبداع

جزاك الله خيرا أخى الحبيب الزباري على مرورك الدائم

هاشم بركات · نوفمبر 8, 2015

بارك الله فيك

تم تعديل نوفمبر 8, 2015 بواسطه هاشم بركات

**Yasser Fathi Albanna** · نوفمبر 8, 2015

1 ساعه مضت, هاشم بركات said:

بارك الله فيك

شكرا لمرورك العطر أخى الكريم / هاشم بركات

**abouelhassan** · نوفمبر 8, 2015

شكر وتقدير واحترام

**Yasser Fathi Albanna** · نوفمبر 8, 2015

شكرا لمرورك العطر أخى / abouelhassan

تقبل خالص تحياتى وتقديرى

عادل زكى · يونيو 27, 2016

سؤال مهم هو اذا كان الشيت محمى سواء باكواد اوتشفير ازاى ممكن وضع كود فية اصلا عزرااااااااااااااااااااااااااااااا

**ياسر العربى** · يونيو 27, 2016

سؤال مهم اخي عادل

تفضل بكل بساطه

http://www.officena.net/ib/topic/66742-فك-حماية-محرر-الاكواد-وحماية-اوراق-العمل/

و

http://www.officena.net/ib/topic/66951-فك-حماية-محرر-الاكواد-xlsm-xlsb-بدون-تحويل-الملفات-ل-xls/

و

بس

تقبل تحياتي

عادل زكى · يونيو 28, 2016

استاذنا الكبير ياسر العربى

لم اجد من كلمات الشكر والعرفان ان نعبر بة عن مدى اعجابنا وتقديرنا لمجهود حضراتكم

واشكر تعب محتك الكبيرة على الرد سريعا

تم تعديل يونيو 28, 2016 بواسطه عادل زكى

asdhamdey · يونيو 28, 2016

Public Sub Sheetpasswordremover()

Dim Mess As String, Header As String
Dim Credit As String
Dim RepBack As String, AllClear As String
Dim PWord1 As String
Dim ShTag As Boolean, WinTag As Boolean
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
Application.ScreenUpdating = False
Header = "فك تشفير صفحات الإكسل"
Credit = vbNewLine & vbNewLine & "منتديات أوفيسنا التعليمية"
RepBack = vbNewLine & vbNewLine & "www.officena.com"
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
Mess = vbNewLine & "لا يوجد كلمة سر للصفحات الحالية" & vbNewLine & Credit
MsgBox Mess, vbInformation, Header
Exit Sub
End If
Mess = "سوف تستغرق عملية فك الحماية ثواني معدودة" & _
vbNewLine & "OK إضغط " & vbNewLine & "وإنتظر حتى يتم فك الحماية " & vbNewLine & _
Credit
MsgBox Mess, vbInformation, Header
If Not WinTag Then
Mess = "" & _
"" & vbNewLine & _
"جاري حذف الحماية " & _
Credit
MsgBox Mess, vbInformation, Header
Else
On Error Resume Next
Do
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)
Mess = "You had a Worksheet Structure or " & vbNewLine & _
Credit
MsgBox Mess, vbInformation, Header
Exit Do
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
Mess = "Only structure / windows protected with " & vbNewLine & _
"the password that was just found." & vbNewLine & _
AllClear & Credit & RepBack
MsgBox Mess, 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 Not ShTag Then
Mess = AllClear & Credit & RepBack
MsgBox Mess, vbInformation, Header
Exit Sub
End If
For Each w1 In Worksheets
With w1
If .ProtectContents Then
On Error Resume Next
Do
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)
Mess = "تم حذف كلمة السر " & _
Credit
MsgBox Mess, vbInformation, Header
For Each w2 In Worksheets
w2.Unprotect PWord1
Next w2
Exit Do
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
Mess = AllClear & Credit & RepBack
MsgBox Mess, vbInformation, Header
End Sub

ربنا يبارك في كل واحد يفيد اخوانه بالعلم الذي افاض الله به عليه

ربنا يحفظ صاحب هذا العمل .. يارب

تسجيل الدخول

إلغاء أى حماية لشيت إكسيل بخطوة واحدة

الردود الموصى بها

Yasser Fathi Albanna

ياسر العربى

عبد العزيز البسكري

Yasser Fathi Albanna

وائل الاسيوطي

Yasser Fathi Albanna

KHMB

Yasser Fathi Albanna

محمد حسن المحمد

احمد الحاوي

Yasser Fathi Albanna

aymnfagr

الزباري

Yasser Fathi Albanna

هاشم بركات

Yasser Fathi Albanna

abouelhassan

Yasser Fathi Albanna

عادل زكى

ياسر العربى

عادل زكى

asdhamdey

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information