عمر أبو صهيب

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

جزاكم الله خيرا أساتذتنا الكبار

أريد كود لمسح بيانات نطاقين دفعة واحدة

النطاق الأول  D3:AK32

النطاق الثاني AM3:BL32

اسم الشيت res_gen

وأين يوضع الكود

و أحسن الله إليكم مسبقا

ربنا يبارك فيك ويرزقكك الاخلاص

 

و فيك بارك أخي الفاضل

 و رزقنا و إياك الإخلاص و القناعة و طول عمر في مرضاته

السلام عليكم

لو فرضنا ان اسم الورقة KHBOOR

ضع هذا الكود في حدث ThisWorkbook

 

Sheets("KHBOOR").ScrollArea = Range("A1:BF75").Address

ثم اغلق الملف وقم بفتحه مرة اخرى

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

جزاك الله خيرا أستاذ محمد صالح

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

فعلا موضوع شيق

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

جزاك الله خيرا أخي الفاضل أيسم إبراهيم

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

الاخ الفاضل الاستاذ / عمر ابو صهيب

جزاك الله كل خير .. ملف ممتاز

جزيت و كفيت و تبوأت من الجنه مقعداً

و الله المستعان

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

مرورك أستاذي احمد فضيله شرفني و أنار صفحتي

في انتظار أن يتم استغلال الكود لإعداد ملف مرفق يستفيد منه الجميع

تقبل أصدق تحياتي و أزكاها

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

أحسن الله إلى كل من يقوم على خدمة الأعضاء و يفيدهم و يضحي بوقته من أجل النفع

السلام عليكم

 

اخي عمر ابوصهيب

مجهود كبير تشكر عليه

جزاك الله خيرا

 

تقبل تحياتي وشكري

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

إجلالي و تقديري

جزاك الله خيرا أخي الفاضل حمادة عمر

الأمر كله مرتبط بجهل وظيفة الجزء الثاني من الكود .

تحياتي الأخوية الصادقة

لا عدمنا اجتهاداتك أمير المعادلات و سلطانها

فعلا الكثير يحتاج إليها و منهم أنا

فجزاك الله عنا ألف خير و يسر لك أمورك كلها

تحياتي الخالصة

قمت بوضع الكود كما يلي :

 

فعلا الأمر يشتغل تمام التمام لكن المشكل يكمن في أن الأمر يطبق على كل ملف تم فتحه بعد ذلك ... و هذا غير مرغوب فيه ... بل أود أن يخص الخيار الملف المطبق عليه فقط .

فما العمل ؟

و جزاكم الله خيرا و بارك في مساعيكم .

أرجو أن يكون المطلوب واضحا بعد الترجمة لأساتذة الأكواد

أسأل الله التوفيق لأساتذتنا الكرام

أنا حديث عهد بالمنتدى و مع ذلك اكتشفت هنا شعار العطاء و البذل بلا من و لا حدود

ثلة من الإخوة الذين يقدمون يد المساعدة لكل عضو بصدر رحب قل نظيره .

إنما علينا أن نقدر ظروفهم الحياتية و العملية ... و إن شاء الله ستجد خيرا

تحياتي الصادقة

معلومات جد قيمة

بارك الله فيك أخي الكريم أيسم إبراهيم

و هنا ترجمة التعليقات الواردة في الكود :

 

' في كود  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

 

سأبدأ بحمد الله بترجمة ما جاء في الوصف على أن أقوم بنفس الشيء مع الكود لاحقا إذا يسر الله ذلك :

تنبيه : استعمال هذا المصدر يتطلب تحكما جيدا في VBA . و أي سوء استعمال قد يؤدي إلى منع الدخول إلى عدة وظائف لبرنامج الإكسل
هذا الملف هو تجميع لعدة حيل بسيطة و معقدة من أجل تحسين حماية الولوج إلى بيانات كود ملف إكسل .
و في هذا المصدر سأبين كيف :
- منع الولوج إلى بعض أزرار شريط الفيجوال بيسك . و بهذا الصدد سأستعمل فصلا يتمكن من اكتشاف النقر على أزرار شريط الفيجوال بيسك .
- منع الدخول إلى نافذة أدوات الماكرو
- منع استعمال الاختصارات ) Alt+F11 و Alt+F8 (التي تتيح تتابعا فتح محرر VBA و نافذة تفعيل الماكرو
-منع استخدام الزر [CapsLok] تزامنا مع فتح الملف ، و هو الزر الذي – كما هو معلوم للجميع – يسمح بفتح الملف في وضعية التعديل و هو ما يعني تعطيل الماكروات عند الفتح .
-منع الدخول إلى الملف و بالتالي الشيتات إذا كانت الماكروات غير مفعلة . و الطريقة المتبعة هنا تختلف عن الطرق التقليدية التي تنتهج إخفاء الشيتات باستعمال XlVeryHidden
- إغلاق محرر VBE تلقائيا إذا كان هدا الأخير مفتوحا في وقت فتح ملف الإكسل . هذا بالإضافة إلى ما تمت الإشارة إليه أعلاه يقوم بمنع الدخول إلى VBE . يشتغل ل X12002 ، X12003 و للتأكيد ل X12007 ( يجب تحميل الملف لمعرفة الطريقة و لكن لا ينصح بها )
الإكسل لا يمكن إغلاقه مادام الملف مفتوحا .
كل هذا الذي تم ذكره غير متاح إلا في الملف نفسه ، و لكن لإضافة بعض التحديدات الأخرى للملفات الأخرى كما الشأن للملف المفتوح ، مثلا الدخول إلى الماكرو من خلال شريط VB أو اختصارات لوحة المفاتيح . يكفي إغلاقه ليعود كل شيء كما كان .
ليس من الممكن – كما يبدو – منع الدخول إلى كود الماكرو إذا كانت الماكروات غير مفعلة إلا برقم سري .
أنا لست خياليا ، إكسل هو غربال و سيبقى غربال رغم كل شيء ، و لكن هنا أقدم حلولا لتقوية الحماية بالمقارنة مع نوع المستخدم
و للتنبيه أن هذا النوع من الحماية ليس أمام المستخدم أي خيار إلا تفعيل الماكرو للدخول إلى الملف ، و بصيغة أخرى إرغامه على خفض مستوى الحماية لديه و بالتالي التعرض للخطر .
 

سأبدأ بحمد الله بترجمة ما جاء في الوصف على أن أقوم بنفس الشيء مع الكود لاحقا إذا يسر الله ذلك :

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 أو اختصارات لوحة المفاتيح . يكفي إغلاقه ليعود كل شيء كما كان .
ليس من الممكن – كما يبدو – منع الدخول إلى كود الماكرو إذا كانت الماكروات غير مفعلة إلا برقم سري .
أنا لست خياليا ، إكسل هو غربال و سيبقى غربال رغم كل شيء ، و لكن هنا أقدم حلولا لتقوية الحماية بالمقارنة مع نوع المستخدم
و للتنبيه أن هذا النوع من الحماية ليس أمام المستخدم أي خيار إلا تفعيل الماكرو للدخول إلى الملف ، و بصيغة أخرى إرغامه على خفض مستوى الحماية لديه و بالتالي التعرض للخطر .

جزى الله خيرا الأخوين الكريمين

دغيدي

و حسين العصلوجي

على عملهما الرائع

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

أخي عمر جزاك الله كل خير 

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

 

دمت في حفظ الله 

مع الأسف أخي الحبيب يحيى لا أتقن اللغة الإنجليزية

و سأحاول تقريب الأمر إلى العربية بعد عودتي من سفر طارئ

تحياتي و محبتي للجميع

وأنا أشرف على إنهاء ملف لحساب معدلات و نتائج مدرسة ابتدائية صادفتني مشكلة :

المستخدم يفتح الملف بشكل عادي و قد يصادف بعض الوظائف غير مفعلة بسبب عدم تمكين الماكروات ..

فكرت في أن يتم تنبيه المستخدم مع بداية تشغيل الملف بحيث تظهر له النافذة التالية :

 

فإذا فعَّلها فتح الملف و إذا لم يفعلها لا يشتغل .

دلني الأخ الكريم حمادة عمر على موضوع الأخ المقتدر عبد الله ... فكان الملف مصمم لغرض آخر.. فهو يفتح بالطريقة المرغوب فيها و لكنه لا يطلب التحفيظ عند الإغلاق .

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

 

الوصف :

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

السلام عليكم

الاخ الكريم / عمر أبو صهيب

 

بارك الله فيك

ورااائع بحثك واصرارك علي التعلم والتقدم

وانتظر منك المزيد وان تكون احد رواد عالم الاكسيل الكبار ( باذن الله )

 

ملفك يعمل بشكل جيد والشاشة تظر بشكل رائع في البداية قبل الملف

ام انك تريد اخفاء الملف نهائيا كما في الشرح

 

اما بخصوص الكود فعلا الكود نتائجة جميله ولكني لا اتقن الفرنسية

فأقترح عليك طرح هذا الملف وهذا الكود في موضوع جديد

ليطلع عليه الاساتذة جميعهم فالمعظم ان شاء الله يتقن الفرنسية وسيفيدنا كثيرا جدا  ( ان شاء الله )

جزاك الله خيرا

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

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

و أفضل أن يتم إخفاء الملف نهائيا و لا يظهر إلا بعد النقر على زر "دخول"

أراهن كثيرا على مساعدتك أخي حمادة عمر لأنها الخطوة الأخيرة لي في الملف قبل توزيعه على أساتذة مؤسستي .

 

أما بخصوص فتح موضوع جديد فسأفعل بحول الله و قوته

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

Limitation sur Command barreV1.6.rar