طريقة عمل شاشة افتتاحية باسم مستخدم ورقم سري !! خطوة خطوة

[basell]

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

[حمادة عمر]

السلام عليكم

الاخ الكريم / basell

 

شكرا جزيلا لمرورك الطيب

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

[الشهابي]

اللهم صل على محمد وعلى آل محمد وسلم

ماشاء الله عليك أستاذ: حمادة 

رائع ومبدع ونشيط نشاط غير محدود 

جزاك الله خير وزادك الله علما ومعرفة 

وأتمنى من إدارة المنتدى تثبيت الموضوع ليستفيد منه جميع الأعضاء

والعفو

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

[غسان العبيدي]

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

[حمادة عمر]

السلام عليكم

اخي الكريم / الشهابي

 

بارك الله فيك

علي مرورك الكريم

وتشجيعك الدائم لي

ومبرك اخي علي التوقيع الجديد  .... راائع

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

[حمادة عمر]

السلام عليكم

الاخ الكريم / GhassanFd

 

بارك الله فيك

رحم الله والديك

حفظك الله اخي الكريم

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

[عمر أبو صهيب]

إبداعات الأخ الكريم حمادة عمر و نشاطه تجعلنا مدينون له بكل التقدير و الاحترام

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

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

 

 ()Private Sub Workbook_Open
UserForm1.Show
End Sub

 

فرجائي الأول أن أعرف طريقة جعل الفورم يقلع في بداية تشغيل الملف

ثانيا ... هل يمكن ربط زر "دخول" مع تفعيل الماكرو مباشرة

الملف في المرفقات

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

 

 

 

 

 

تم تعديل فبراير 28, 2013 بواسطه عمر أبو صهيب

[حمادة عمر]

السلام عليكم

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

 

بارك الله فيك

وجزاك الله خيرا علي كلماتك الرائعة والجميله

وجعله في ميزان حسناتك

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

 

ولكن بالنسبة لطلبك ان تظهر رسالة او شاشة تفيد للمستخدم تمكين الماكرو

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

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

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

 

اما بالنسبة لملفك فلا يمكنني تحميله ( برجاء رفعه مرة اخري )

ولكن انت فعلا تقوم بالخطوات الصحيحة ففعلا الكود يوضع في حدث ThisWorkbook  بالشكل التالي :

Private Sub Workbook_Open()
UserForm1.Show
End Sub

ولكن اولا يجب عليك التأكد هل اسم الفورم الذي قمت بتصميمه وجعله الشاشة الرئيسية بنفس الاسم في الكود UserForm1 ام هناك فرق ... فيجب ان يكون بنفس اسم الفورم الذي

تريد ظهوره في البداية  ....

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

مع التأكد ايضا من اسم الفورم

Sub auto_open()
UserForm1.Show
End Sub

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

تم تعديل فبراير 28, 2013 بواسطه حمادة عمر

[ياسر الحافظ]

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

 

واضيف : و يسر امرك  وامنك السلام بديارك 

تشكر  استاذ حمادة 

وفقك الله 

ابو الحارث 

 

[حمادة عمر]

السلام عليكم

الاستاذ القدير / ياسر الحافظ  ( ابو الحارث )  .... حفظك الله

 

بارك الله فيك

مرورك علي الموضوع شرفه وشرف صاحب الموضوع

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

[عمر أبو صهيب]

بارك الله فيك أخي حمادة عمر

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

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

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

[عمر أبو صهيب]

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

Limitation sur Command barreV1.6.rar

تم تعديل مارس 1, 2013 بواسطه عمر أبو صهيب

[حمادة عمر]

السلام عليكم

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

 

بارك الله فيك

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

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

 

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

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

 

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

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

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

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

[عمر أبو صهيب]

السلام عليكم

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

 

بارك الله فيك

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

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

 

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

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

 

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

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

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

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

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

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

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

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

 

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

[حمادة عمر]

السلام عليكم

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

 

بارك الله فيك

ولك مني ارق تحيه وتقدير علي كلماتك الرائعة الجميله

التي لا يضاهيها شئ

واعدك انني سأبذك قصاري جهدي للوصول الي اي شئ ولو بسيط في هذا الموضوع

ولكن هو موضوع معقد بعض الشئ !!!

وسأخبرك فور ذلك ومن الممكن ان نجد ايضا الرد عند احد خبراؤنا .. فالجميع ايضا لديه الكثير

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

[سما محمد]

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

فعلا استفدت كثيرا جدا جدا من هذا الموضوع الرائع

شكرا لك

[حمادة عمر]

السلام عليكم

الاخت الفاضلة / سما محمد

 

بارك الله فيكي

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

[حمادة عمر]

اللهم صلي علي سيدنا ((( محمد )) وعلي آله وصحبه اجمعين

[اوفيس 2003]

بارك الله فيك استاذ حماده

 

ياريت لو تساعدني موضوع مشابه

 

http://www.officena.net/ib/index.php?showtopic=45736

[abdoullah]

جزاك الله خير استاذ حمادة وإلى الأمام ونحن نتمنى ايضا شرح بعض الأكواد خاص اكواد اللوب واكواد التكرار مع كود اف if  مع for

if  مع loop

 وبالتوفيق

[abdoullah]

بارك الله فيكم وفي جميع الإساتذة ونفع بكم

[إبراهيم ابوليله]

اخى الحبيب

حماده عمر

مشكورا على المجهود المبذول منك

فى مساعدة الكل من اجل التعلم والترقى

بارك الله فيك

[حمادة عمر]

السلام عليكم

الاخ الكريم / office 2003

 

بارك الله فيك

تفضل اخي راجع الرابط الخاص بك به الاجابة علي الطلب

 

http://www.officena.net/ib/index.php?showtopic=45736&p=270741

 

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

[حمادة عمر]

السلام عليكم

الاخ الكريم / abdoullah

 

بارك الله فيك

وان شاء سيتم عمل ذلك في حينه

في الموضوعات القادمة ( باذن الله )

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

[حمادة عمر]

السلام عليكم

الاخ الكريم / إبراهيم ابوليله

 

بارك الله فيك

وهذا اخي الكريم ما تعلمناه جميعا من اساتذة وخبراء هذا الصرح

وهو رد لجميلهم علينا

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