اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

عمر أبو صهيب

03 عضو مميز
  • Posts

    146
  • تاريخ الانضمام

  • تاريخ اخر زياره

كل منشورات العضو عمر أبو صهيب

  1. جزاك الله خيرا أخي احمد عبد الناصر و على تعاونك و كرمك الحاتمي
  2. جزاكم الله خيرا أساتذتنا الكبار أريد كود لمسح بيانات نطاقين دفعة واحدة النطاق الأول D3:AK32 النطاق الثاني AM3:BL32 اسم الشيت res_gen وأين يوضع الكود و أحسن الله إليكم مسبقا
  3. و فيك بارك أخي الفاضل و رزقنا و إياك الإخلاص و القناعة و طول عمر في مرضاته
  4. قمت بتجربة الكود أخي عبد الله و لكنني لم أفلح في الوصول إلى النتيجة المبتغاة
  5. جزاك الله خيرا أستاذ محمد صالح لكن أمن سبيل لتظهر الرسالة حتى قبل تفعيل الماكروات ؟؟؟
  6. فعلا موضوع شيق لكن تبقى الإشكالية العالقة التي صادفتها في عدة مواضيع مشابهة هي عدم ظهور رسالة الحفظ قبل الإغلاق
  7. جزاك الله خيرا أخي الفاضل أيسم إبراهيم
  8. مرورك أستاذي احمد فضيله شرفني و أنار صفحتي في انتظار أن يتم استغلال الكود لإعداد ملف مرفق يستفيد منه الجميع تقبل أصدق تحياتي و أزكاها و عليكم السلام و رحمة الله و بركاته
  9. أحسن الله إلى كل من يقوم على خدمة الأعضاء و يفيدهم و يضحي بوقته من أجل النفع
  10. كلماتك أيها الأستاذ الكريم تدفعني للمزيد من الوفاء للمنتدى و أهله و تشعرني بالفخر و الاعتزاز إجلالي و تقديري
  11. جزاك الله خيرا أخي الفاضل حمادة عمر الأمر كله مرتبط بجهل وظيفة الجزء الثاني من الكود . تحياتي الأخوية الصادقة
  12. لا عدمنا اجتهاداتك أمير المعادلات و سلطانها فعلا الكثير يحتاج إليها و منهم أنا فجزاك الله عنا ألف خير و يسر لك أمورك كلها تحياتي الخالصة
  13. قمت بوضع الكود كما يلي : فعلا الأمر يشتغل تمام التمام لكن المشكل يكمن في أن الأمر يطبق على كل ملف تم فتحه بعد ذلك ... و هذا غير مرغوب فيه ... بل أود أن يخص الخيار الملف المطبق عليه فقط . فما العمل ؟ و جزاكم الله خيرا و بارك في مساعيكم .
  14. أرجو أن يكون المطلوب واضحا بعد الترجمة لأساتذة الأكواد أسأل الله التوفيق لأساتذتنا الكرام
  15. أنا حديث عهد بالمنتدى و مع ذلك اكتشفت هنا شعار العطاء و البذل بلا من و لا حدود ثلة من الإخوة الذين يقدمون يد المساعدة لكل عضو بصدر رحب قل نظيره . إنما علينا أن نقدر ظروفهم الحياتية و العملية ... و إن شاء الله ستجد خيرا تحياتي الصادقة
  16. معلومات جد قيمة بارك الله فيك أخي الكريم أيسم إبراهيم
  17. و هنا ترجمة التعليقات الواردة في الكود : ' في كود ThisWorkBook 'Macro Créée par : BigFish (Philippe E) 'le :06-11-2008 'Mis à jour le : 03/09/2010 'V1.3 ' Option Explicit Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Cancel = True HideSheets WBkSave (SaveAsUI) End Sub Private Sub Workbook_Open() Dim CmdBs As CommandBar ' إذا تم تفعيل الماكروات سيتم إظهار الشيتات المخفية ' و في حالة العكس تبقى مخفية و تظهر رسالة خطأ ' تركت هذا الخيار الذي يشتغل إذا كان الملف لم يحفظ مع ' خيار IsAddin is True . في حالة العكس لا يعني الأمر شيئا . Application.Run ("Opening") ‘ تعطيل شريط نافذة أدوات كونترول For Each CmdBs In Application.CommandBars Select Case CmdBs.Name Case "Control Toolbox", "Boîte à outils Contrôles" 'cas Anglais ou Français CmdBs.Enabled = False End Select Next ' تهيئة الفصل / القسم Set XlAppli.XL = Excel.Application Call XlAppli.InitClass ' منع استخدام اختصارات لوحة المفاتيح Alt+F11 و Alt+F8 Application.OnKey "%{F11}", "MessageDeLimitation" Application.OnKey "%{F8}", "MessageDeLimitation" DoEvents ' هذا الملف تم حفظه مع خيار IsAddin is True إذن يتم تحويله إلى False ‘ لإعادة إعطائه كل وظائف Workbook التقليدية If ThisWorkbook.IsAddin = True Then ThisWorkbook.IsAddin = False 'إذا كان VBE مفتوحا يتم إغلاقه و لكن ليشتغل الأمر يجب أن يكون خيار الأمان " الثقة في مشروع فيجوال بيسك " مؤشرا عليه . On Error Resume Next If Application.VBE.MainWindow.Visible = True Then Application.VBE.MainWindow.Visible = False MyFileIsOpen = True End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) ' البعض مما سيأتي لاحقا لا يصلح إلا لإدارة مرور IsAddin = True لهذا الملف في حالة كان المستخدم يرغب في التحفيظ قبل الإغلاق . ' لهذا سيتم استبدال رسالة الإكسل برسالتنا الشخصية مما يسمح بإدارة حالة الزر "إلغاء" If MyFileIsOpen = True Then Exit Sub Dim Reponse As VbMsgBoxResult If ThisWorkbook.Saved = True Then ' عودة إلى الإفتراضي العادي Defaut ' يتم إفراغ القسم/ الفصل Call XlAppli.EmptyClass Else Cancel = True ' هنا رسالتنا الشخصية On Error Resume Next Reponse = MsgBox("Do you want to save the changes made in '" & ActiveWorkbook.Name & "' ? ", vbExclamation + vbYesNoCancel) Select Case Reponse Case vbYes 'l'utilisateur veut sauver avant de fermer le fichier HideSheets Application.EnableEvents = False 'pour eviter de passer par l'evenement Workbook_BeforeSave ThisWorkbook.IsAddin = True ThisWorkbook.Save ThisWorkbook.Saved = True Application.EnableEvents = True Application.DisplayAlerts = True Application.ScreenUpdating = True Cancel = False Case vbNo 'l'utilisateur ne veut pas sauver. Pour cela: ' عودة إلى الإفتراضي العادي Defaut ' يتم إفراغ القسم / الفصل Call XlAppli.EmptyClass ' يتم إيهام الإكسل أن الملف تم حفظه ThisWorkbook.Saved = True نسمح بالإغلاق Cancel = False End Select ' في حالة "إلغاء" لا يتم تنفيذ أي شيء End If End Sub ----------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------- ' في الموديل المسمى module1 'Macro Créée par : BigFish (Philippe E) 'le :15-11-2008 'Mis à jour le : 03/09/2010 'V1.4 ' Option Explicit Public XlAppli As New ClasseAppli, MyFileIsOpen As Boolean Sub Defaut() Dim CmdBtn As Office.CommandBarButton, CmdBs As CommandBar إعادة استعمال اختصارات لوحة المفاتيح Alt+F11 و Alt+F8 Application.OnKey "%{F11}" Application.OnKey "%{F8}" تفعيل شريط صندوق أدوات الكونترول For Each CmdBs In Application.CommandBars Select Case CmdBs.Name Case "Control Toolbox", "Boîte à outils Contrôles" CmdBs.Enabled = True End Select Next End Sub Sub viderclass() Call XlAppli.EmptyClass End Sub Sub HideSheets() ' إخفاء كل الشيتات باستثناء شيت starting notice ' ' تركت هذا الخيار الذي يشتغل إذا كان الملف لم يحفظ مع Dim MySheet As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False If Sheets("starting notice").Visible = xlVeryHidden Then Sheets("starting notice").Visible = True For Each MySheet In ThisWorkbook.Worksheets If Not MySheet.Name = "starting notice" Then MySheet.Visible = xlVeryHidden End If Next End Sub Sub Opening() Dim MySheet As Worksheet ' إخفاء كل الشيتات باستثناء شيت starting notice Application.ScreenUpdating = False Application.DisplayAlerts = False ThisWorkbook.IsAddin = False For Each MySheet In ThisWorkbook.Worksheets If Not MySheet.Name = "starting notice" Then MySheet.Visible = True End If Next If Sheets("starting notice").Visible = True Then Sheets("starting notice").Visible = xlVeryHidden Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True ThisWorkbook.Saved = True End Sub Sub WBkSave(ByVal SaveAsUI As Boolean) ' هنا يتم الأخذ بعين الإعتبار التحفيظات للتمكن من إدارة خيار IsAddin Dim FileSaveName As String, Reponse As VbMsgBoxResult Application.DisplayAlerts = False Application.EnableEvents = False If SaveAsUI = False Then 'sauvegarde direct ThisWorkbook.IsAddin = True ThisWorkbook.Save Else 'sauver sous FileSaveName = Application.GetSaveAsFilename(ThisWorkbook.Name) If Not FileSaveName = "False" Then 'si l'utilisateur n'a pas utilisé le bouton Cancel If Not Dir(FileSaveName) = "" Then 'si le fichier existe deja Reponse = MsgBox("le fichier '" & Dir(FileSaveName) & "' existe déjà. voulez-vous remplacer le fichier existant ? ", vbExclamation + vbYesNo) If Reponse = vbYes Then ThisWorkbook.IsAddin = True ThisWorkbook.SaveAs Filename:=FileSaveName, AddToMru:=True End If Else 'si le fichier n'existe pas ThisWorkbook.IsAddin = True ThisWorkbook.SaveAs Filename:=FileSaveName, AddToMru:=True End If End If End If Application.EnableEvents = True DoEvents 'on donne les moyens a excel de faire la sauvegarde avant de passer a la suite Opening End Sub Sub MessageDeLimitation() MsgBox "Vos droits sur ce fichier ne vous permettent pas d'acceder à ces fonctions !", vbExclamation End Sub Sub ClosingThisFile() MyFileIsOpen = False ThisWorkbook.Close End Sub ----------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------- ' في الموديل الفصل / القسم المسمى ClasseAppli 'Macro Créée par : BigFish (Philippe E) 'Macro Créée par : BigFish (Philippe E) 'le :15-11-2008 'Mis à jour le : 03/09/2010 'V1.2 ' Option Explicit Public WithEvents XL As Excel.Application Dim ClassCmdBrBtn() As ClasseCommandeBarBouton, NbButton As Integer ' السماح بإفراغ الفصل / القسم Public Sub EmptyClass() Dim i As Integer For i = 1 To NbButton On Error Resume Next Set ClassCmdBrBtn(i).BoutonBarre = Nothing Next End Sub ' تعبئة الفصل / القسم Public Sub InitClass() Dim i As Integer, MyCmdBar As CommandBar NbButton = Application.CommandBars("Visual Basic").Controls.Count ' يتم تحديد عدد الأزرار و يتم تحجيم صفيف الجدول the array variable ReDim Preserve ClassCmdBrBtn(NbButton) ' يضاف إلى الفصل / القسم أزرار شريط الفيجوال بيسك For i = 1 To NbButton Set ClassCmdBrBtn(i) = New ClasseCommandeBarBouton Set ClassCmdBrBtn(i).BoutonBarre = Application.CommandBars("Visual Basic").Controls(i) Next End Sub Private Sub XL_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean) ' منع إغلاق هذا الملف أو الإكسل مادام مفتوحا If Wb.Name = ThisWorkbook.Name And MyFileIsOpen = True Then Cancel = True End If End Sub ----------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------- ' في موديل الفصل / القسم المسمى ClasseCommandeBarBouton 'Macro Créée par : BigFish (Philippe E) 'le :05-11-2008 'V1.1 ' Option Explicit Public WithEvents BoutonBarre As office.CommandBarButton Private Sub BoutonBarre_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) Select Case Ctrl.Caption Case "&Design Mode", "&Visual Basic Editor", "Control T&oolbox", "&Record New Macro...", "&Macros..." CancelDefault = True Action ' النسخة الإنجليزية إلى حدود XI2003 Case "Nouv&elle macro...", "&Visual Basic Editor", "&Boîte à outils Contrôles", "Mode &Création" CancelDefault = True Action ' النسخة الفرنسية بداية من XI2007 Case "Mo&de Création" CancelDefault = True Action End Select End Sub Sub Action() MsgBox "Vos droits sur ce fichier ne vous permettent pas d'acceder à ces fonctions !", vbExclamation End Sub ----------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------- 'في كود الورقة "Sheet1" 'Macro Créée par : BigFish (Philippe E) 'le 03/09/2010 'V1.0 ' ' زر "أغلق هذا الملف" للشيت "Sheet1" Private Sub CommandButton1_Click() ClosingThisFile End Sub
  18. سأبدأ بحمد الله بترجمة ما جاء في الوصف على أن أقوم بنفس الشيء مع الكود لاحقا إذا يسر الله ذلك : تنبيه : استعمال هذا المصدر يتطلب تحكما جيدا في VBA . و أي سوء استعمال قد يؤدي إلى منع الدخول إلى عدة وظائف لبرنامج الإكسل هذا الملف هو تجميع لعدة حيل بسيطة و معقدة من أجل تحسين حماية الولوج إلى بيانات كود ملف إكسل . و في هذا المصدر سأبين كيف : - منع الولوج إلى بعض أزرار شريط الفيجوال بيسك . و بهذا الصدد سأستعمل فصلا يتمكن من اكتشاف النقر على أزرار شريط الفيجوال بيسك . - منع الدخول إلى نافذة أدوات الماكرو - منع استعمال الاختصارات ) Alt+F11 و Alt+F8 (التي تتيح تتابعا فتح محرر VBA و نافذة تفعيل الماكرو -منع استخدام الزر [CapsLok] تزامنا مع فتح الملف ، و هو الزر الذي – كما هو معلوم للجميع – يسمح بفتح الملف في وضعية التعديل و هو ما يعني تعطيل الماكروات عند الفتح . -منع الدخول إلى الملف و بالتالي الشيتات إذا كانت الماكروات غير مفعلة . و الطريقة المتبعة هنا تختلف عن الطرق التقليدية التي تنتهج إخفاء الشيتات باستعمال XlVeryHidden - إغلاق محرر VBE تلقائيا إذا كان هدا الأخير مفتوحا في وقت فتح ملف الإكسل . هذا بالإضافة إلى ما تمت الإشارة إليه أعلاه يقوم بمنع الدخول إلى VBE . يشتغل ل X12002 ، X12003 و للتأكيد ل X12007 ( يجب تحميل الملف لمعرفة الطريقة و لكن لا ينصح بها ) الإكسل لا يمكن إغلاقه مادام الملف مفتوحا . كل هذا الذي تم ذكره غير متاح إلا في الملف نفسه ، و لكن لإضافة بعض التحديدات الأخرى للملفات الأخرى كما الشأن للملف المفتوح ، مثلا الدخول إلى الماكرو من خلال شريط VB أو اختصارات لوحة المفاتيح . يكفي إغلاقه ليعود كل شيء كما كان . ليس من الممكن – كما يبدو – منع الدخول إلى كود الماكرو إذا كانت الماكروات غير مفعلة إلا برقم سري . أنا لست خياليا ، إكسل هو غربال و سيبقى غربال رغم كل شيء ، و لكن هنا أقدم حلولا لتقوية الحماية بالمقارنة مع نوع المستخدم و للتنبيه أن هذا النوع من الحماية ليس أمام المستخدم أي خيار إلا تفعيل الماكرو للدخول إلى الملف ، و بصيغة أخرى إرغامه على خفض مستوى الحماية لديه و بالتالي التعرض للخطر .
  19. سأبدأ بحمد الله بترجمة ما جاء في الوصف على أن أقوم بنفس الشيء مع الكود لاحقا إذا يسر الله ذلك : ATTENTION L'UTILISATION DE CETTE SOURCE DEMANDE UNE BONNE MAÎTRISE DU VBA. Une mauvaise maîtrise vous interdiras l’accès à plusieurs fonctions d'excel. Ce fichier regroupe plusieurs petites ou grosses astuces pour améliorer la sécurité d’accès aux données et au code d'un fichier excel. Dans cette source je montre comment: - Interdire l’accès à certain bouton de la barre Visual basic. Sur ce point j'utilise une classe qui permet de détecter le clic sur les boutons de la barre visual basic. - Interdire l’accès à la boite à outils macro. - Interdire l'utilisation des raccourcis Alt+F11 et Alt+F8 qui permettent respectivement d'ouvrir l’éditeur VBE et la boite Lancer Macro - Interdire l'utilisation de la touche [Maj] à l'ouverture du fichier. Touche qui comme vous le savez déjà permet d'ouvrir un fichier excel en mode création ce qui a pour effet de désactiver les macros lors de l'ouverture. - Interdire l'accés au fichier donc aux feuilles si les macros non pas été activées. La methode utilisé ici est differente de la methode classic qui consiste à cacher les feuilles avec l'option XlVeryHidden. - Fermer l'editeur VBE automatiquement si celui-ci est ouvert au moment de l'ouverture du fichier excel. Ceci plus les interdits listés plus haut permettent d'interdire l'accés au VBE. Fonctionne pour Xl2002, Xl2003 à confirmer pour Xl2007.(Vous devrez télécharger le fichier pour voir la méthode mais n'est pas renseignées !) - Excel ne peut être fermé tant que le fichier est ouvert Touts ceci n'est valable que pour le fichier lui meme, mais peut ajouter quelques limitations aux autres fichiers tant que celui-ci est ouvert comme par exemple l'accés au macros via la barre visual basic ou les racourcis clavier. Il suffit de le fermer pour que tout rentre dans l'ordre. Il n'est apparemment pas possible d'interdire l'accés au code si les macros n'ont pas été activées sauf par mot de passe. Je ne suis pas utopiste, excel est une passoire et reste une passoire malgré tout, mais ici je donne des solutions pour renforcer la securité par rapport a un utilisateur de base voir un utilisateur deja bien initié. En tout cas ceci ajouté aux mots de passe peut en rebuter plus d'un. Mais attention ceci a sont revers en effet avec ce type de protection l'utilisateur n'a plus d'autre choix que d'activer les macros pour acceder au fichier. Autrement dit vous l'obligez à baisser sa garde donc à ce mettre en danger. تنبيه : استعمال هذا المصدر يتطلب تحكما جيدا في VBA . و أي سوء استعمال قد يؤدي إلى منع الدخول إلى عدة وظائف لبرنامج الإكسل هذا الملف هو تجميع لعدة حيل بسيطة و معقدة من أجل تحسين حماية الولوج إلى بيانات كود ملف إكسل . و في هذا المصدر سأبين كيف : - منع الولوج إلى بعض أزرار شريط الفيجوال بيسك . و بهذا الصدد سأستعمل فصلا يتمكن من اكتشاف النقر على أزرار شريط الفيجوال بيسك . - منع الدخول إلى نافذة أدوات الماكرو - منع استعمال الاختصارات ) Alt+F11 و Alt+F8 (التي تتيح تتابعا فتح محرر VBA و نافذة تفعيل الماكرو -منع استخدام الزر [CapsLok] تزامنا مع فتح الملف ، و هو الزر الذي – كما هو معلوم للجميع – يسمح بفتح الملف في وضعية التعديل و هو ما يعني تعطيل الماكروات عند الفتح . -منع الدخول إلى الملف و بالتالي الشيتات إذا كانت الماكروات غير مفعلة . و الطريقة المتبعة هنا تختلف عن الطرق التقليدية التي تنتهج إخفاء الشيتات باستعمال XlVeryHidden - إغلاق محرر VBE تلقائيا إذا كان هدا الأخير مفتوحا في وقت فتح ملف الإكسل . هذا بالإضافة إلى ما تمت الإشارة إليه أعلاه يقوم بمنع الدخول إلى VBE . يشتغل ل X12002 ، X12003 و للتأكيد ل X12007 ( يجب تحميل الملف لمعرفة الطريقة و لكن لا ينصح بها ) الإكسل لا يمكن إغلاقه مادام الملف مفتوحا . كل هذا الذي تم ذكره غير متاح إلا في الملف نفسه ، و لكن لإضافة بعض التحديدات الأخرى للملفات الأخرى كما الشأن للملف المفتوح ، مثلا الدخول إلى الماكرو من خلال شريط VB أو اختصارات لوحة المفاتيح . يكفي إغلاقه ليعود كل شيء كما كان . ليس من الممكن – كما يبدو – منع الدخول إلى كود الماكرو إذا كانت الماكروات غير مفعلة إلا برقم سري . أنا لست خياليا ، إكسل هو غربال و سيبقى غربال رغم كل شيء ، و لكن هنا أقدم حلولا لتقوية الحماية بالمقارنة مع نوع المستخدم و للتنبيه أن هذا النوع من الحماية ليس أمام المستخدم أي خيار إلا تفعيل الماكرو للدخول إلى الملف ، و بصيغة أخرى إرغامه على خفض مستوى الحماية لديه و بالتالي التعرض للخطر .
  20. جزى الله خيرا الأخوين الكريمين دغيدي و حسين العصلوجي على عملهما الرائع
  21. مع الأسف أخي الحبيب يحيى لا أتقن اللغة الإنجليزية و سأحاول تقريب الأمر إلى العربية بعد عودتي من سفر طارئ تحياتي و محبتي للجميع
  22. وأنا أشرف على إنهاء ملف لحساب معدلات و نتائج مدرسة ابتدائية صادفتني مشكلة : المستخدم يفتح الملف بشكل عادي و قد يصادف بعض الوظائف غير مفعلة بسبب عدم تمكين الماكروات .. فكرت في أن يتم تنبيه المستخدم مع بداية تشغيل الملف بحيث تظهر له النافذة التالية : فإذا فعَّلها فتح الملف و إذا لم يفعلها لا يشتغل . دلني الأخ الكريم حمادة عمر على موضوع الأخ المقتدر عبد الله ... فكان الملف مصمم لغرض آخر.. فهو يفتح بالطريقة المرغوب فيها و لكنه لا يطلب التحفيظ عند الإغلاق . بحثتت فوجدت في أحد المواقع الفرنسية اجتهادا و لكنني لا أعرف طريقة استعمال الأكواد .. لذلك سأضعها أمامكم ليستفيد من يرغب و يفيدنا من يستطيع جزاه الله خيرا . الوصف : ATTENTION L'UTILISATION DE CETTE SOURCE DEMANDE UNE BONNE MAÎTRISE DU VBA. Une mauvaise maîtrise vous interdiras l’accès à plusieurs fonctions d'excel. Ce fichier regroupe plusieurs petites ou grosses astuces pour améliorer la sécurité d’accès aux données et au code d'un fichier excel. Dans cette source je montre comment: - Interdire l’accès à certain bouton de la barre Visual basic. Sur ce point j'utilise une classe qui permet de détecter le clic sur les boutons de la barre visual basic. - Interdire l’accès à la boite à outils macro. - Interdire l'utilisation des raccourcis Alt+F11 et Alt+F8 qui permettent respectivement d'ouvrir l’éditeur VBE et la boite Lancer Macro - Interdire l'utilisation de la touche [Maj] à l'ouverture du fichier. Touche qui comme vous le savez déjà permet d'ouvrir un fichier excel en mode création ce qui a pour effet de désactiver les macros lors de l'ouverture. - Interdire l'accés au fichier donc aux feuilles si les macros non pas été activées. La methode utilisé ici est differente de la methode classic qui consiste à cacher les feuilles avec l'option XlVeryHidden. - Fermer l'editeur VBE automatiquement si celui-ci est ouvert au moment de l'ouverture du fichier excel. Ceci plus les interdits listés plus haut permettent d'interdire l'accés au VBE. Fonctionne pour Xl2002, Xl2003 à confirmer pour Xl2007.(Vous devrez télécharger le fichier pour voir la méthode mais n'est pas renseignées !) - Excel ne peut être fermé tant que le fichier est ouvert Touts ceci n'est valable que pour le fichier lui meme, mais peut ajouter quelques limitations aux autres fichiers tant que celui-ci est ouvert comme par exemple l'accés au macros via la barre visual basic ou les racourcis clavier. Il suffit de le fermer pour que tout rentre dans l'ordre. Il n'est apparemment pas possible d'interdire l'accés au code si les macros n'ont pas été activées sauf par mot de passe. Je ne suis pas utopiste, excel est une passoire et reste une passoire malgré tout, mais ici je donne des solutions pour renforcer la securité par rapport a un utilisateur de base voir un utilisateur deja bien initié. En tout cas ceci ajouté aux mots de passe peut en rebuter plus d'un. Mais attention ceci a sont revers en effet avec ce type de protection l'utilisateur n'a plus d'autre choix que d'activer les macros pour acceder au fichier. Autrement dit vous l'obligez à baisser sa garde donc à ce mettre en danger. الكود Dans le code du ThisWorkBook: 'Macro Créée par : BigFish (Philippe E) 'le :06-11-2008 'Mis à jour le : 03/09/2010 'V1.3 ' Option Explicit Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Cancel = True HideSheets WBkSave (SaveAsUI) End Sub Private Sub Workbook_Open() Dim CmdBs As CommandBar 'si les macros on ete activées les feuilles cachées seront affichées 'dans le cas contraire elle resteront cachées et un message d'erreur apparaitra. 'j'ai laissé cette option qui fonctionne si ce fichier n'est pas enregistré avec 'l'option IsAddin a vrai. Dans le cas contraire cela ne sert a rien Application.Run ("Opening") 'desactive la barre "Boîte à outils Contrôles" For Each CmdBs In Application.CommandBars Select Case CmdBs.Name Case "Control Toolbox", "Boîte à outils Contrôles" 'cas Anglais ou Français CmdBs.Enabled = False End Select Next 'initialisation de la classe Set XlAppli.XL = Excel.Application Call XlAppli.InitClass 'on interdit l'utilisation des racourcis Alt+F11 et Alt+F8 Application.OnKey "%{F11}", "MessageDeLimitation" Application.OnKey "%{F8}", "MessageDeLimitation" DoEvents 'ce fichier a été sauvé avec l'option IsAddin a vrai donc on le passe a false 'pour lui redonner toutes ses fonctions de Workbook classic If ThisWorkbook.IsAddin = True Then ThisWorkbook.IsAddin = False 'si le VBE est ouvert on le ferme mais pour que cela fonctionne l'option 'de securite "Faire confiance au projet Visual Basic" doit etre cochée. On Error Resume Next If Application.VBE.MainWindow.Visible = True Then Application.VBE.MainWindow.Visible = False MyFileIsOpen = True End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) 'une partie de ce qui suit ne sert qu'a gerer le passage IsAddin = True de ce fichier si 'l'utilisateur veut sauver avant de fermer 'Pour cela on vas substituer au message d'excel notre propre message ce qui 'permet de gerer le cas du bouton cancel If MyFileIsOpen = True Then Exit Sub Dim Reponse As VbMsgBoxResult If ThisWorkbook.Saved = True Then 'retour a la normale Defaut 'on vide la classe Call XlAppli.EmptyClass Else Cancel = True 'ici notre message perso: On Error Resume Next Reponse = MsgBox("Voulez-vous sauver les modifications effectuées dans '" & ActiveWorkbook.Name & "' ? ", vbExclamation + vbYesNoCancel) Select Case Reponse Case vbYes 'l'utilisateur veut sauver avant de fermer le fichier HideSheets Application.EnableEvents = False 'pour eviter de passer par l'evenement Workbook_BeforeSave ThisWorkbook.IsAddin = True ThisWorkbook.Save ThisWorkbook.Saved = True Application.EnableEvents = True Application.DisplayAlerts = True Application.ScreenUpdating = True Cancel = False Case vbNo 'l'utilisateur ne veut pas sauver. Pour cela: 'retour a la normale Defaut 'on vide la classe Call XlAppli.EmptyClass 'on laisse croire excel que le fichier a été sauvé ThisWorkbook.Saved = True 'on autorise la fermeture Cancel = False End Select ' si cancel rien ne ce passe End If End Sub ----------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------- Dans le module nomé module1 'Macro Créée par : BigFish (Philippe E) 'le :15-11-2008 'Mis à jour le : 03/09/2010 'V1.4 ' Option Explicit Public XlAppli As New ClasseAppli, MyFileIsOpen As Boolean Sub Defaut() Dim CmdBtn As office.CommandBarButton, CmdBs As CommandBar 'Retablit l'utilisation des raccourcis Alt+F11 et Alt+F8 Application.OnKey "%{F11}" Application.OnKey "%{F8}" 'Active la barre "Boîte à outils Contrôles" For Each CmdBs In Application.CommandBars Select Case CmdBs.Name Case "Control Toolbox", "Boîte à outils Contrôles" CmdBs.Enabled = True End Select Next End Sub Sub viderclass() Call XlAppli.EmptyClass End Sub Sub HideSheets() 'Cache toute les feuilles a l'exception de la feuille starting notice 'j'ai laissé cette option qui fonctionne si ce fichier n'est pas enregistré avec 'l'option IsAddin a vrai. Dans le cas contraire cela ne sert a rien Dim MySheet As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False If Sheets("starting notice").Visible = xlVeryHidden Then Sheets("starting notice").Visible = True For Each MySheet In ThisWorkbook.Worksheets If Not MySheet.Name = "starting notice" Then MySheet.Visible = xlVeryHidden End If Next End Sub Sub Opening() Dim MySheet As Worksheet 'Affiche toute les feuilles a l'exception de la feuille starting notice Application.ScreenUpdating = False Application.DisplayAlerts = False ThisWorkbook.IsAddin = False For Each MySheet In ThisWorkbook.Worksheets If Not MySheet.Name = "starting notice" Then MySheet.Visible = True End If Next If Sheets("starting notice").Visible = True Then Sheets("starting notice").Visible = xlVeryHidden Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True ThisWorkbook.Saved = True End Sub Sub WBkSave(ByVal SaveAsUI As Boolean) 'ici on prend en charge les sauvegardes pour pouvoir gerer l'option IsAddin Dim FileSaveName As String, Reponse As VbMsgBoxResult Application.DisplayAlerts = False Application.EnableEvents = False If SaveAsUI = False Then 'sauvegarde direct ThisWorkbook.IsAddin = True ThisWorkbook.Save Else 'sauver sous FileSaveName = Application.GetSaveAsFilename(ThisWorkbook.Name) If Not FileSaveName = "False" Then 'si l'utilisateur n'a pas utilisé le bouton Cancel If Not Dir(FileSaveName) = "" Then 'si le fichier existe deja Reponse = MsgBox("le fichier '" & Dir(FileSaveName) & "' existe déjà. voulez-vous remplacer le fichier existant ? ", vbExclamation + vbYesNo) If Reponse = vbYes Then ThisWorkbook.IsAddin = True ThisWorkbook.SaveAs Filename:=FileSaveName, AddToMru:=True End If Else 'si le fichier n'existe pas ThisWorkbook.IsAddin = True ThisWorkbook.SaveAs Filename:=FileSaveName, AddToMru:=True End If End If End If Application.EnableEvents = True DoEvents 'on donne les moyens a excel de faire la sauvegarde avant de passer a la suite Opening End Sub Sub MessageDeLimitation() MsgBox "Vos droits sur ce fichier ne vous permettent pas d'acceder à ces fonctions !", vbExclamation End Sub Sub ClosingThisFile() MyFileIsOpen = False ThisWorkbook.Close End Sub ----------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------- Dans le module de classe nomé ClasseAppli 'Macro Créée par : BigFish (Philippe E) 'Macro Créée par : BigFish (Philippe E) 'le :15-11-2008 'Mis à jour le : 03/09/2010 'V1.2 ' Option Explicit Public WithEvents XL As Excel.Application Dim ClassCmdBrBtn() As ClasseCommandeBarBouton, NbButton As Integer 'Permet de vider la classe Public Sub EmptyClass() Dim i As Integer For i = 1 To NbButton On Error Resume Next Set ClassCmdBrBtn(i).BoutonBarre = Nothing Next End Sub 'Remplissage de la classe Public Sub InitClass() Dim i As Integer, MyCmdBar As CommandBar NbButton = Application.CommandBars("Visual Basic").Controls.Count 'on determine le nombre de bouton et on dimensionne la variable tableau ReDim Preserve ClassCmdBrBtn(NbButton) 'on Ajoute a la classe chaque bouton de la barre Visual Basic For i = 1 To NbButton Set ClassCmdBrBtn(i) = New ClasseCommandeBarBouton Set ClassCmdBrBtn(i).BoutonBarre = Application.CommandBars("Visual Basic").Controls(i) Next End Sub Private Sub XL_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean) 'interdit la fermeture de ce classeur ou d'excel tant qu'il est ouvert If Wb.Name = ThisWorkbook.Name And MyFileIsOpen = True Then Cancel = True End If End Sub ----------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------- Dans le module de classe nomé ClasseCommandeBarBouton 'Macro Créée par : BigFish (Philippe E) 'le :05-11-2008 'V1.1 ' Option Explicit Public WithEvents BoutonBarre As office.CommandBarButton Private Sub BoutonBarre_Click(ByVal Ctrl As office.CommandBarButton, CancelDefault As Boolean) Select Case Ctrl.Caption 'Version Anglaise jusqu'a Xl2003 Case "&Design Mode", "&Visual Basic Editor", "Control T&oolbox", "&Record New Macro...", "&Macros..." CancelDefault = True Action 'Version Française jusqu'a Xl2003 Case "Nouv&elle macro...", "&Visual Basic Editor", "&Boîte à outils Contrôles", "Mode &Création" CancelDefault = True Action 'Version Française A partir de Xl2007 Case "Mo&de Création" CancelDefault = True Action End Select End Sub Sub Action() MsgBox "Vos droits sur ce fichier ne vous permettent pas d'acceder à ces fonctions !", vbExclamation End Sub ----------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------- Dans le code de la feuille "Sheet1" 'Macro Créée par : BigFish (Philippe E) 'le 03/09/2010 'V1.0 ' 'Bouton [Fermer ce fichier] de la feuille "Sheet1" Private Sub CommandButton1_Click() ClosingThisFile End Sub و في المرفقات تجدون ملفا من نفس الموقع يطبق الطريقة أتمنى أن تكون هذه المشاركة مفيدة و جزى الله خيرا أخي الفاضل حمادة عمر الذي نصحني بفتح هذا الموضوع Limitation sur Command barreV1.6.rar
  23. أسعدتني كلماتك أخي الكريم حمادة عمر ... و للعلم أن ردودك و اهتامك كان له الأثر الكبير في ارتباطي بالمنتدى . و بالمقابل سأجن من هذا الملف ففي حاسوبي يفتح الملف أولا بشكل عادي و لا تظهر الشاشة إلا بعد تفعيل الماكرو ... بينما أرغب أن تظهر الشاشة أولا . و أفضل أن يتم إخفاء الملف نهائيا و لا يظهر إلا بعد النقر على زر "دخول" أراهن كثيرا على مساعدتك أخي حمادة عمر لأنها الخطوة الأخيرة لي في الملف قبل توزيعه على أساتذة مؤسستي . أما بخصوص فتح موضوع جديد فسأفعل بحول الله و قوته
  24. و تجدون ملفا مرفقا تم تحميله من نفس الموقع تطبيق الكود السابق عليه Limitation sur Command barreV1.6.rar
×
×
  • اضف...

Important Information