jeudi 16 mars 2017

صلاحيات للوصول لشيتات

بسم الله الرحمن الرحيم
اليوم هنعرف ازاي نعمل صلاحيات للوصول لشيتات معينه داخل ملف الاكسيل
بعد ما راجعنا الدرس السابق نبدأ من حيث انتهينا
الأساسيات
الشاشة الرئيسية
1.PNG.486a5134c0bf200235e61446d8c293a5
الصفحات الأخرى
2.PNG.ec142d2af460bc4f6dd8d338864c9f88
3.PNG.ddd7b623d2d2604385f56ad77ded3daf
4.PNG.ed7d6af0a8469181eb91475a91d1c383
وأخيرا صفحة  معلومات الدخول والصلاحيات
5.PNG.5202e03ec0d9955807916d8beb6e85b5
ودي أسماء الصفحات داخل الشيتات وبرمجيا
6.PNG.2d8c3e57133bed0a33b09ce261f110ef
نقوم بتصميم نفس الصفحات السابقة
أظن سهلة العملية لحد دلوقتي
حان دور الاكواد
نبدأ بالاكواد السهلة
في كل صفحة غير الرئيسية بها زر رجوع نضع الاكواد كالاتي
صفحة ادخال البيانات في زر الرجوع
 

Sub yasser1()
index.Activate
sheet1.Visible = xlSheetVeryHidden
End Sub
السطر الاول للرجوع للصفحة الرئيسية
السطر الثاني لاخفاء صفحة ادخال البيانات وهي شيت1
وتكرر في الصفحات المتبقية
صفحة الاستعلام

Sub yasser2()
index.Activate
sheet2.Visible = xlSheetVeryHidden
End Sub
صفحة قاعدة البيانات

Sub yasser3()
index.Activate
sheet3.Visible = xlSheetVeryHidden
End Sub
صفحة المستخدمون users

Sub mohamed1()
index.Select
users.Visible = xlSheetVeryHidden
End Sub
 
 
وقبل ان نترك صفحة اليوزرز
 
نضع هذه المعادلات
 
7.PNG.05fb0570d283a346fdda82ced81d39ff
 
 
=IF(J2="";"";VLOOKUP(J2;A2:E8;3;FALSE))
 
=IF(J2="";"";VLOOKUP(J2;A2:E8;4;FALSE))
 
=IF(J2="";"";VLOOKUP(J2;A2:E8;5;FALSE))
 
هذه الدوال تجلب بيانات المستخدم من جدول المستخدمين ومنها نقوم بالتحكم في صلاحياته
 
الآن حان دور الصفحة الرئيسية
نضع في اول زر وهو زر ادخال البيانات الكود التالي
 
10.PNG.634e567d57cff398d8f451830fd44da8
 

Sub aseel1()
If users.Range("k2") = "yes" Then
Application.ScreenUpdating = False
sheet1.Visible = xlSheetVisible
sheet1.Select
Else
MsgBox "انت لا تمتلك الصلاحية لدخول هذه الصفحة ", vbCritical, "elmalak_elhazen_yasser@yahoo.com"
Application.ScreenUpdating = True
End If
End Sub
 
زر الصفحة الثانية صفحة الاستعلام
 
11.PNG.b80241e544cb7884c8793df2c3de5b39

Sub aseel2()
If users.Range("L2") = "yes" Then
Application.ScreenUpdating = False
sheet2.Visible = xlSheetVisible
sheet2.Select
Else
MsgBox "انت لا تمتلك الصلاحية لدخول هذه الصفحة ", vbCritical, "elmalak_elhazen_yasser@yahoo.com"
Application.ScreenUpdating = True
End If
End Sub
زر الصفحة الثالثة صفحة قاعدة البيانات
 
12.PNG.b43067685ae8a4cd34d09e82edc46d86
Sub aseel3()
If users.Range("m2") = "yes" Then
Application.ScreenUpdating = False
sheet3.Visible = xlSheetVisible
sheet3.Select
Else
MsgBox "انت لا تمتلك الصلاحية لدخول هذه الصفحة ", vbCritical, "elmalak_elhazen_yasser@yahoo.com"
Application.ScreenUpdating = True
End If
End Sub
زر الصفحة الرابعة صفحة صلاحيات اليوزرز
 
13.PNG.16ce8d0fa6f674fc5fbbc3190971b2c9
وهنا سنغير الكود  سنعطى لهذه الصفحة كلمة مرور خاصة غير باقي الصفحات
 

Sub mohamed()
Dim x
    x = InputBox("يرجى ادخال كلمة المرور.", "Password Required")
    If x = "123" Then
users.Visible = xlSheetVisible
users.Select
        Else
        MsgBox "كلمة المرور خطأ يرجى اعداة المحاولة"
    End If
End Sub

 
  
اكواد الصفحات تعتمد علي
اول سطر يقوم بمقارنة  الخلية الخاصة بالصفحة اذا كانت بها كلمة yes
فيسمح بالدخول اما غير ذلك لا يمكن الدخول
والجزء الثان من الكود يقوم باظهار الصفحة عند تحقق الشرط والذهاب اليها
ينقصنا سطر صغير لاتمام الموضوع
8.PNG.924314d0b99a9a3a1e5f4aa1410ed301
نسخ اسم المستخدم عند الدخول الى الخلية المحددة ليتم جلب بيانته عن طريق اسمه
وتتم كالاتي
9.PNG.445f386b89956dd99b8cc5e7f9878782
يتم وضع الكود في حدث زر الدخول
10.PNG.a6ffdf1efe11fe311cb5189dc6ab2bd5
 
users.Range("j2") = ComboBox1.Value
وبكدا يكون انتهى الدرس
لتحميل مثال اضغط هنا  
تقبلوا تحياتي
ياسر العربي
اعادة نشر

مرفق الملف
attachصلاحيات.rar

ومرفق اخر معدل ليسع اكبر قدر من الشيتات
MTQ2MzgxMQ7777123456







منقول للأمانة
شكرا للأخ ياسر

XlsMilev

Résuméabuiyad

vendredi 10 mars 2017

ربط الصور بقائمة منسدلة على ورقة العمل

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

إخواني وأحبابي في الله أقدم لكم درس جديد ، بعيداً عن الأكواد هذه المرة 
أقدم لكم بالتفصيل كيفية ربط الصور بقائمة منسدلة على ورقة العمل ، وقد وضحت الخطوات بالتفصيل في الصور التالية 
 
Mjc1NzY0MQ1313001 MTQ5NDgyMQ2525002 MzM5MjE3MQ4747003 MjExODk5MQ4646004 MTcwNDkxMQ4040005 MTM4MzI4MQ5050006 NDQwODAxMQ33007 MTYzODg5MQ2121008 MTE3NDUx009 OTgyNzMx010 MzE4NTU5MQ6363011 MTQ0NTYx012

منقول للأمانة

XlsMilev

Résuméabuiyad

مواقيت الصلاة


Propellerads