عمر أبو صهيب

بارك الله فيك أخي حمادة عمر فعلا حل الأخ عبد الله باقشير مفيد و لكن عيبه (بالنسبة لي) أن الملف لا يطالبك بالحفظ عند الخروج منه بل يحفظ رغما عنك . و أنا أبحث عثرت على موضوع في أحد المواقع و لكنه بالفرنسية ... و أنا لا أتقن التعامل مع الكواد و استعمالها لهذا سأطرحه هنا للإفادة و الإستفادة : 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 أتمنى أن يكون الأمر مفيدا كما أنني أعدت تحميل الملف في المرفقات omar66.rar

إبداعات الأخ الكريم حمادة عمر و نشاطه تجعلنا مدينون له بكل التقدير و الاحترام فجزاه الله عنا خيرا و بارك في مساعيه استفدت من موضوعك و أنجزت فورما بدون رقم سري لعدم الحاجة إليه ... فقط الغرض منه تذكير المستعمل بتفعيل الماكروات ... لكن الإشكال أن الفورم لا يظهر مباشرة مع تشغيل الملف بل بعد تشغيل الماكرو و بالتالي فقد أهميته ... و قد وضعت في Thisworkbook ... الكود التالي : ()Private Sub Workbook_Open UserForm1.Show End Sub فرجائي الأول أن أعرف طريقة جعل الفورم يقلع في بداية تشغيل الملف ثانيا ... هل يمكن ربط زر "دخول" مع تفعيل الماكرو مباشرة الملف في المرفقات و جزاك الله خيرا و جعل تعبك في ميزان حسناتك يوم لا ينفع مال و لا بنون

بوركت أخي الفاضل إسلام الشيمي الأمر بسيط ... و لكن لا يمكنني أن أوضحه بشكل جيد ...هههههه لأنني بكل بساطة أستعمل الإصدار الفرنسي من الإكسل و لكن سأحاول تقريب الطريقة 1/ إعداد لائحة منسدلة 2/ استعمال التنسيق الشرطي في الجدول الأول 3/ عتماد دالة NB.SI بالفرنسية و أظنها IF.COUNT بالإنجليزية (و الله أعلم) في الجدول الثاني ... و لها علاقة بالمضمون و ليس باللون (علاقة متعدية) : مضمون الخلية في الجدول الأول مرتبط باللون و العدد في الجدول الثاني مرتبط بالمضمون و بالتالي فالعدد مرتبط باللون ... أعتذر مرة أحرى من أساتذتي الكرام

أعتذر من أساتذة المنتدى و أعمدته فأنا لست أهلا للردود و لكن أرجو أن أكون موفقا في الجواب مع بساطته count by color.rar

للرفع و التحديث

عمل أكثر من رائع من أخ أروع هذا يجعل الفكرة أكثر تنوعا فجزاك الله ألف خير

عطاء و إبداع أخي الكريم مجدي يونس جزاك الله خيرا على ما أتحفتنا به و الشكر كذلك للأخ ssiko

ألف ألف مبروك أخي الكريم احمد عبد الناصر فعلا عضو مميز و باقتدار نشاط متقد تواجد مستمر عطاء و بذل أسأل الله أن يوفقك و يسدد خطاك و يجعلك دائما معطاء تحياتي الخالصة

ما زلت أبحث عن الحل لكنني لم أوفق بعد بارك الله فيكم

معذرة ... ربما لم أفهم جيدا المقصود من الكود ... و هو ليس المقصود من طلبي طلبي جزاكم الله خيرا و بارك فيكم و في أمثالكم عندما أفتح الملف أريد أن يعطيني النافذة التالية : فعندما يتم اختيار "تفعيل الماكرو" يفتح الملف و عندما يتم اختيار "تعطيل الماكرو" يغلق الملف . عند اختيار " تفعيل الماكرو" و فتح الملف أقوم بإجراء تغييرات ... و عندما أريد الإغلاق يجب أن يعطيني النافذة الاعتيادية التالية : حتى أختار بين "حفظ" أو "عدم الحفظ" أو "إلغاء" . أرجو أن تكون الفكرة واضحة أحسن الله إليكم.

أخي الكريم رجب جاويش رفع الله قدرك .... فالطلب كما تمنيته تماما و الشكر موصول للأخ عبد الله باقشير على إبداعاته المميزة في أمان الله

معذرة أخي الكريم عبد الله ... ربما لم أفهم جيدا المقصود من الكود طلبي جزاك الله خيرا و بارك فيك و في أمثالك عندما أفتح الملف أريد أن يعطيني النافذة التالية : فعندما يتم اختيار "تفعيل الماكرو" يفتح الملف و عندما يتم اختيار "تعطيل الماكرو" يغلق الملف . عند اختيار " تفعيل الماكرو" و فتح الملف أقوم بإجراء تغييرات ... و عندما أريد الإغلاق يجب أن يعطيني النافذة الاعتيادية التالية : حتى أختار بين "حفظ" أو "عدم الحفظ" أو "إلغاء" . أرجو أن تكون الفكرة واضحة أحسن الله إليك .

جزاك الله خيرا أخي الكريم حمادة عمر مبدع كعادتك

كلي أمل في ذلك أخي الكريم

نورك الله أخي حمادة و أحسن إليك إنما صادفت مشكلا بعد استعمال كود أخينا عبد الله Option Explicit Sub Auto_Open() kh_wVisible True End Sub Sub Auto_Close() kh_wVisible False ThisWorkbook.Close Not CBool(ThisWorkbook.Saved) End Sub Sub kh_wVisible(ibol As Boolean) Dim nBook As String nBook = ThisWorkbook.Name With Windows(nBook) If .Visible = Not ibol Then .Visible = ibol End With End Sub هو أنه الملف يقوم بحفظ التعديلات التي أقوم بها تلقائيا و لا تظهر نافذة ( هل تريد حفظ التغييرات التي أجريتها أم لا) بل يغلق مباشرة مع الحفظ .

جزاكما الله خيرا الأخوان الكريمان حمادة عمر و new4a على الإفادة ملف الأخ عبد الله المجرب يفي بالغرض في مجاله . و لكن ماذا لو أردت أن يتوقف الملف بعد استعماله لمدة ثلاثين يوما ( كما الشأن بالنسبة للبرامج التجريبية ) و أحسن الله إليكم جميعا مسبقا

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

أخي الكريم عبد الله صادفتني مشكلة عند اعتماد الكود في ملفي ... Option Explicit Sub Auto_Open() kh_wVisible True End Sub Sub Auto_Close() kh_wVisible False ThisWorkbook.Close Not CBool(ThisWorkbook.Saved) End Sub Sub kh_wVisible(ibol As Boolean) Dim nBook As String nBook = ThisWorkbook.Name With Windows(nBook) If .Visible = Not ibol Then .Visible = ibol End With End Sub عندما أقوم بتغييرات فيه و أغلقه لا تظهر النافذة الاعتيادية التي تقترح حفظ التغييرات أو عدم الحفظ بل يغلق مباشرة و يحفظ التعديلات تلقائيا . فأين مكمن المشكل يا ترى و جزاكم الله خيرا و نفع بكم و أثابكم الجنة

بارك الله فيك أخي الكريم طارق محمود على الكود الذي أحتاجه و لكن لا أدري لماذا لم يشتغل معي - مع العلم أنني مبتدئ في هذا المجال - و إذ أرفق الملف مع مشاركتي و لكن طمعي أكثر في شرح سبب عدم اشتغاله أكثر من طمعي في إصلاح الخطأ و تقبل تحياتي الحارة Classeur1.rar

أساتذة بمعنى الكلمة أتمنى أن أستفيد من بعض ما علمكم إياه ربنا تحياتي الخالصة

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

جزاك الله خيرا أخي عبد الله على الموضوع القيم و بارك في أخينا حمادة عمر الذي دلني على رابط الموضوع

جزاك الله خيرا أخي رجب جاويش لا تهتم بشأن الجداول أخي المهم الصفحات ... فالصفحة 1 بها جدولين متشابهين (شهادتين متطابقتين للتلميذة "مليكة") للدورة الأولى . و هكذا إلى غاية الصفحة 30 ( أي تلاثين تلميذا ) و أريد وضع ماكرو للطباعة بحيث لا يطبع الثلاثين صفحة كلها بل يطبع فقط عدد الصفحات بعدد التلاميذ الموجود في الخانة D5 فعند النقر على الزر 1 يطبع النطاق 2 - الذي يبتدئ بالصفحة 1 - إلى حدود الصفحة رقم (X) الموجود في الخانة 3 . و عند النقر على الزر 4 يطبع النطاق 5 - الذي يبتدئ بالصفحة 31 - إلى حدود الصفحة رقم (Y) الذي يساوي (X+30) . أرجو أن تكون الفكرة قد وضحت و أتمنى المعذرة أخي و أن تتحمل بساطة معلوماتي في هذا المجال

أطلب من الإخوة الكرام إفادتي عن طريقة لجعل نافذة تفعيل الماكرو تظهر تلقائيا مع تشغيل ملف الإكسل الذي أنشأته . و جزى الله خيرا كل القائمين على المنتدى و أعضائه الذي يسعون جاهدين على إفادة الآخرين مما علمهم الله .

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