تعديل الكود

[صلاح الصغير]

هذا كود خلاصة مساعدة الاساتذة الكرام

و اخص بالذكر الاستاذ / ياسر خليل

Private Sub Workbook_Open()
Application.Visible = False
kh_AhlnWShln
End Sub



Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
      Dim MyFilePath$, Extension$
      MyFilePath = "d:\حسابات\مراجعة\"
      Extension = Left(ThisWorkbook.Name, Len _
                                          (ThisWorkbook.Name) - 4) & " Backup"

      On Error Resume Next      '<< folder exists
      MkDir MyFilePath & Extension      '<< create folder
      'save current version of this book in the folder
      ActiveWorkbook.SaveCopyAs Filename:=MyFilePath & _
                                          Extension & "\" & Extension & _
                                          (Format(Now, " yyyy mm dd, hh.mm.ss AMPM")) & ".xlsm"
End Sub

Public Function MyPCpath$(Folder)
      MyPCpath = CreateObject("WScript.Shell").SpecialFolders _
                 (Folder) & Application.PathSeparator
End Function

و الفكرة الاساسية هى الكود الاول و هو يقوم بغلق الاكسيل فى حالة عدم تفعيل الماكرو و اظهار صفحة خالية وفى حالى تفعيل الماكرو يقوم باستدعاء شاشة الدخول اى تأمين 100 %

و هذا هو كود الاستاذ / ياسر و الذى يعمل على اخفاء الاوراق و اظهار ورقة بها رسالة بضرورة تفعيل الماكرو

'يوضع الكود في حدث المصنف ويقوم بإخفاء كل أوراق العمل في حالة عدم تمكين الماكرو
'أي أنه يجبر المستخدم على تفعيل الماكرو لإظهار أوراق العمل ، أما في حالة إذا ما
'كان الماكرو مفعل ، فإن ورقة العمل التحذيرية تختفي وتظهر بقية أوراق العمل
'-------------------------------------------------------------------------------

'قم بتعيين اسم ورقة العمل التحذيرية
Const Warning As String = "Warning"

Private Sub Workbook_Open()
    Dim Ws As Worksheet

    Application.ScreenUpdating = False
        For Each Ws In ThisWorkbook.Worksheets
            Ws.Visible = xlSheetVisible
        Next Ws
    
        Sheets(Warning).Visible = xlVeryHidden
    Application.ScreenUpdating = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Ws As Worksheet

    Application.ScreenUpdating = False
        Sheets(Warning).Visible = xlSheetVisible
    
        For Each Ws In ThisWorkbook.Worksheets
            If Ws.Name <> Warning Then
                Ws.Visible = xlVeryHidden
            End If
        Next Ws
    Application.ScreenUpdating = True

    ActiveWorkbook.Save
End Sub

و المراد ادماج الكودين فقط فى الجزئية الخاصة بالاستاذ / ياسر 

و شكرا

[ياسر خليل أبو البراء]

أخي الكريم صلاح

ضع الأكواد كلها في موديول حدث المصنف

ثم احذف الجزء الأول وادمجه في حدث فتح المصنف

Application.Visible = False
kh_AhlnWShln

جرب الكود بهذا الشكل

Const Warning As String = "Warning"

Private Sub Workbook_Open()
    Dim Ws As Worksheet

    Application.ScreenUpdating = False
        For Each Ws In ThisWorkbook.Worksheets
            Ws.Visible = xlSheetVisible
        Next Ws
    
        Sheets(Warning).Visible = xlVeryHidden
    
        'أسطر الدمج
        Application.Visible = False
        kh_AhlnWShln
        
    Application.ScreenUpdating = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Ws As Worksheet

    Application.ScreenUpdating = False
        Sheets(Warning).Visible = xlSheetVisible
    
        For Each Ws In ThisWorkbook.Worksheets
            If Ws.Name <> Warning Then
                Ws.Visible = xlVeryHidden
            End If
        Next Ws
    Application.ScreenUpdating = True

    ActiveWorkbook.Save
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim MyFilePath$, Extension$
    MyFilePath = "d:\حسابات\مراجعة\"
    Extension = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & " Backup"

    On Error Resume Next      '<< folder exists
    MkDir MyFilePath & Extension      '<< create folder
    'save current version of this book in the folder
    ActiveWorkbook.SaveCopyAs Filename:=MyFilePath & Extension & "\" & Extension & (Format(Now, " yyyy mm dd, hh.mm.ss AMPM")) & ".xlsm"
End Sub

Public Function MyPCpath$(Folder)
    MyPCpath = CreateObject("WScript.Shell").SpecialFolders(Folder) & Application.PathSeparator
End Function

تقبل تحياتي

[صلاح الصغير]

شكرا ا / ياسر 

تم نسخ الكود و لكن هناك خطا فى هذا السطر

تم اضافة ورقة باسم warning و تم تدارك الخطأ و لكن لا يتم تفعيل السطرين المدمجين اى ان الاكسيل لا يراهم و يعمل الكود كما هو على قديمه يعنى

تم تعديل مايو 27, 2016 بواسطه صلاح الصغير

[ياسر خليل أبو البراء]

قم بإرفاق ملفك للإطلاع عليه ..لأنني لا أعلم المشكلة بالضبط

لربما بعد الإطلاع على الملف نستطيع أن نعرف المشكلة بالضبط

تقبل تحياتي

[صلاح الصغير]

اليوزر : صلاح

الباس : 24229197

ملاحظة الكودين موجودين و معطل الكود الاصلى

salah 2016.rar

تم تعديل مايو 27, 2016 بواسطه صلاح الصغير

[ياسر خليل أبو البراء]

جرب تضع الجملة التالية قبل السطر الذي يحدث فيه الخطأ ..

On Error Resume Next

أنا جربت الملف وفتحته ثم قمت بإغلاقه ولم يحدث معي المشكلة في السطر المذكور ..

لاحظت أن قلت أنك عطلت الكود الأصلي ..! هل يمكنك وضع الأكواد بدون تعطيل للوقوف على المشكلة بشكل عملي ..

[صلاح الصغير]

ا / ياسر

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

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

و شكرااااا

[ياسر خليل أبو البراء]

طيب جرب السطر اللي أدرجته في المشاركة السابقة وشوف هيحصل ايه...

 

[صلاح الصغير]

للاسف لم يحدث شيئا

[ياسر خليل أبو البراء]

هل تقصد بكلمة لم يحدث شيء أي لم يحدث خطأ أم أن الكود لم ينفذ المطلوب ..ما هو المتوقع من تنفيذ الكود؟

[صلاح الصغير]

اى لم ينفذ المطلوب

فى الكود القديم يظهر الاكسيل بهذا الشكل فى حالة تعطيل الماكرو

و المطلوب فى حالة تعطيل الماكرو يفتح الملف على الورقة المخفية كما فى كود حضرتك

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

تم تعديل مايو 27, 2016 بواسطه صلاح الصغير

[ياسر خليل أبو البراء]

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

يرجى عدم وضع كلمات سر للملف

تقبل تحياتي

[صلاح الصغير]

ا / ياسر هذا هوا الملف مرة اخرى و به الكود الخاص بك فقط

اما عن الباسوورد فهى تظهر اليا فى حالة تفعيل الماكرو و فى حالة عدم تفعيله يظهر الاكسل

بالشكل الموجود فى المشاركة السابقة و اذا شلته هنجرب ازاى الكود

يوزر : صلاح

باس : 24229197

salah 2016.rar

[ياسر خليل أبو البراء]

بصراحة ملف غريب وعجيب ...

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

هل قمت بالتلاعب في XML الخاص بالملف ؟؟؟!!

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

[صلاح الصغير]

فعلا ا / ياسر عندك حق

عموما يا باشا خد راحتك ده كودك و انت حر فيه

بس انا و الله ما لعبت فى حاجة كل الموضوع يمكن يفيدكم فى حاجة انى حفظت الملف الاصلى الى امتداد binary 

لتقليل حجم الملف

[صلاح الصغير]

فعلا حاجة غريبة انا عطلت كل الاكواد و عطلت الماكرو و اوراق العمل لم تظهر

[صلاح الصغير]

up

[صلاح الصغير]

up

[صلاح الصغير]

للرفع

[صلاح الصغير]

للرفع