إجمالي مرات مشاهدة الصفحة

الخميس، 24 نوفمبر، 2016

تصميم برنامج عارض للصور Image Viewer Using VBA

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

أقدم لكم بالتفصيل كيفية تصميم برنامج بسيط لعرض الصور على ورقة عمل داخل الإكسيل ، وإليكم الخطوات مشروحة بالصور 













 الكود المستخدم في تصميم البرنامج :

كليك يمين على اسم ورقة العمل ثم اختر الأمر View Code ثم الصق الكود التالي (لاحظ أن الكود في حدث ورقة العمل وليس في موديول جديد)

Private Sub cmdBrowse_Click()
    'تعريف المتغيرات
    Dim FD As FileDialog
    Dim vImage As Variant
    Dim vItem As Variant
    
    '[Skipper] سطر لتجنب حدوث خطأ حيث يتم الانتقال للنقطة المسماة
    On Error GoTo Skipper
    
    'سطر لفتح نافذة مستعرض الملفات لاختيار مجلد الصور
    Set FD = Application.FileDialog(msoFileDialogOpen)
    
    'بدء التعامل مع نافذة مستعرض الملفات
    With FD
        
        'مسح فلاتر النافذة وهي خاصة بالامتدادات
        FD.Filters.Clear
        
        '[JPG] إضافة امتداد الصور
        FD.Filters.Add "Pictures", "*.jpg"

        'تمكين اختيار أكثر من ملف أو صورة
        .AllowMultiSelect = True

        'الخروج من الإجراء الفرعي في حالة عدم اختيار ملفات
        If .Show = False Then Exit Sub

        'مسح محتويات صندوق القائمة
        ListBox1.Clear
        
        'حلقة تكرارية لكل عنصر من العناصر التي تم اختيارها من نافذة المستعرض
        For Each vItem In .SelectedItems
        
            'إضافة مسار الصورة إلى صندوق القائمة
            ListBox1.AddItem vItem
            
        'الانتقال للعنصر التالي
        Next vItem

        'اختيار أول صورة في القائمة لتكون الصورة الافتراضية
        ListBox1.ListIndex = 0
    
    'انتهاء التعامل مع نافذة المستعرض
    End With

    'الخروج من الإجراء الفرعي
    Exit Sub
    
'نقطة الهروب في حالة حدوث خطأ
Skipper:
    
    'ظهور رسالة للمستخدم تفيد بأنه لم يتم التمكن من تحميل الصور
    MsgBox "Can't Load The Images", vbCritical
End Sub

Private Sub cmdNext_Click()
    'الانتقال للصورة التالية
    If ListBox1.ListIndex < ListBox1.ListCount - 1 Then
        ListBox1.ListIndex = ListBox1.ListIndex + 1
    End If
End Sub

Private Sub cmdPrevious_Click()
    'الانتقال للصورة السابقة
    If ListBox1.ListIndex > 0 Then
        ListBox1.ListIndex = ListBox1.ListIndex - 1
    End If
End Sub

Private Sub cmdReset_Click()
    'مسح محتويات صندوق القائمة وإزالة الصورة الموجودة في أداة الصورة
    ListBox1.Clear
    Image1.Picture = LoadPicture("")
End Sub

Private Sub ListBox1_Click()
    'تحميل الصورة في أداة الصورة من خلال المسار الموجود في نص العنصر المحدد في صندوق القائمة
    Image1.Picture = LoadPicture(ListBox1.Text)
End Sub

كيفية استخدام البرنامج :

قم بالنقر على زر الأمر Browse ، ستظهر لك نافذة المستعرض للملفات ، حدد المجلد الذي يحتوي على الصورة المطلوب عرضها ، ثم حدد الصور ، ستظهر لك قائمة بأسماء ومسارات ملفات الصور في الأداة ListBox1 ، الآن يمكنك استعراض أي صورة بمجرد كليك على المسار الموجود أو يمكنك استخدام زري الأمر Next و Previous للتنقل بين الصور.


إعداد / ياسر خليل أبو البراء 


السبت، 12 نوفمبر، 2016

توليد امتحان بشكل عشوائي من بنك أسئلة Generate Random Test Paper From Questions Bank

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


إذا كنت من واضعي أسئلة اختبارات ولديك بنك أسئلة ، وتريد اختبار مجموعة من المتقدمين ، بحيث يكون لكل متقدم 10 أسئلة بشكل عشوائي ، حتى لا يكون الامتحان مكرر بشكل متعمد .. أقدم لكم هذا الكود الذي يقوم بتوليد 10 أسئلة مختلفة في كل مرة يتم تنفيذ الكود فيها.

بفرض أن لديك في ورقة العمل Sheet2 مجموعة كبيرة من الأسئلة (بنك الأسئلة) ، والمطلوب هو توليد 10 أسئلة في كل مرة يتم تنفيذ الكود فيها ، وتظهر النتائج في ورقة العمل Sheet1

إليكم الكود المستخدم لهذه المهمة مع الشرح لأسطر الكود بالتفصيل

Sub Generate_Test()
    'الإعلان عن المتغيرات
    Dim i                   As Long
    Dim rowNum              As Long
    Dim qNum                As Long

    'إلغاء خاصية تحديث الشاشة لتسريع الكود
    Application.ScreenUpdating = False

    'تعيين قيمة للمتغير ليساوي عدد الأسئلة في ورقة بنك الأسئلة وهنا
    'استخدمنا دالة العد لتقوم بعد الخلايا في العمود الأول في ورقة الأسئلة
    qNum = Application.WorksheetFunction.CountA(Sheets("Sheet2").Columns(1))

    'بدء التعامل مع ورقة النتائج التي تريد توليد الأسئلة العشوائية بها
    With Sheets("Sheet1")

        'مسح محتويات النطاق الذي سيحتوي على النتائج
        .Range("A2:A10000").ClearContents

        'حلقة تكرارية من 1 إلى 10 ويمثل عدد الأسئلة المطلوب توليدها
        'إذا أردت أن تقوم بتوليد عدد أسئلة أكثر قم بتغيير الرقم 10
        For i = 1 To 10

'نقطة انتقال بحيث لو كان السؤال مكرر يرجع لتلك النقطة
Generate:
            'توليد رقم عشوائي بين 1 و أكبر عدد للأسئلة لاختيار صف عشوائي
            rowNum = Application.RoundUp(Rnd() * qNum, 0)

            'هذا الجزء للتأكد من أن السؤال غير مكرر حيث استخدمت دالة العد المشروط
            If Application.CountIf(.[A:A], Sheets("Sheet2").Cells(rowNum, "A")) = 0 Then

                'في حالة أن السؤال غير مكرر يتم جلب السؤال من ورقة الأسئلة
                .Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Sheets("Sheet2").Cells(rowNum, "A").Value
            Else

                'في حالة أن السؤال مكرر يتم الرجوع لنقطة الانتقال
                'لإعادة توليد رقم صف عشوائي جديد
                GoTo Generate

            'نهاية جملة الشرط
            End If

        'الانتقال للحلقة التالية أي للسؤال التالي
        Next i

    'نهاية التعامل مع ورقة العمل
    End With

    'إعادة تفعيل خاصية تحديث الشاشة
    Application.ScreenUpdating = True
End Sub


إعداد / ياسر خليل أبو البراء

الأحد، 30 أكتوبر، 2016

إنشاء فهرس لكل أوراق العمل بشكل تلقائي Auto Generate INDEX For Sheets

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

أقدم لكم كود بسيط ومفيد جداً ، وهو يقوم بإنشاء فهرس في ورقة العمل الرئيسية بأوراق العمل الأخرى وإنشاء ارتباط تشعبي بها.



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



إلى هنا فحسب ، وإليكم الكود ، وهو يوضع في حدث ورقة العمل المطلوب إنشاء الفهرس بها ، ويتم ذلك عن طريق كليك يمين على اسم ورقة العمل ثم اختر View Code ثم الصق الكود

Private Sub Worksheet_Activate()
    'تعريف المتغيرات
    Dim ws      As Worksheet
    Dim I       As Long

    'تعيين قيمة للمتغير ليساوي 1 ويمثل أول صف لوضع النتائج
    I = 1
    
    'بدء التعامل مع ورقة العمل التي تحتوي الكود
    With Me
        
        'مسح محتويات العمود الأول وهو عمود النتائج
        .Columns(1).ClearContents
        
        '[A1] في الخلية [INDEX] وضع كلمة
        .Cells(1, 1) = "INDEX"
        
        '[Index] تسمية الخلية الأولى باسم نطاق معرف باسم
        .Cells(1, 1).Name = "Index"
    
    'جملة الانتهاء من التعامل مع ورقة العمل
    End With

    'حلقة تكرارية لكل أوراق العمل
    For Each ws In Worksheets
    
        'استثناء ورقة العمل التي تحتوي الكود من الحلقة التكرارية
        If ws.Name <> Me.Name Then
        
            'زيادة مقدار قيمة الصف بمقدار واحد
            I = I + 1
            
            'بدء التعامل مع ورقة العمل الهدف
            With ws
            
                'يليها رقم فهرس الورقة [Start] وضع تسمية لأول خلية في الورقة الهدف باسم
                .Range("A1").Name = "Start" & ws.Index
                
                '[Back To Index] إنشاء ارتباط تشعبي في ورقة العمل الهدف بعنوان
                'والذي يوجد في أول خلية في الورقة الرئيسية [Index] عنوان الارتباط هو النطاق المسمى
                .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", SubAddress:="Index", TextToDisplay:="Back To Index"
                
            'انتهاء التعامل مع الورقة الهدف
            End With
            
            'إنشاء ارتباط تشعبي للخلية في الورقة الرئيسية بعنوان ورقة العمل الهدف
            'والذي يليه رقم فهرس الورقة [Start] عنوان الارتباط التشعبي هو النطاق المسمى
            Me.Hyperlinks.Add Anchor:=Me.Cells(I, 1), Address:="", SubAddress:="Start" & ws.Index, TextToDisplay:=ws.Name
            
        'نهاية جملة الشرط
        End If
    
    'الانتقال للورقة التالية في أوراق المصنف
    Next ws
End Sub


إعداد / ياسر خليل أبو البراء

السبت، 29 أكتوبر، 2016

عرض الصور على الفورم من خلال الليست بوكس Display Pictures In ListBox On UserForm

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

أقدم لكم بطريقة مبسطة كيفية إنشاء فورم لعرض الصور للأشخاص من خلال النقر على اسم الشخص في الليست بوكس


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

خطوات العمل :
* قم بإدراج فورم من خلال قائمة Insert ثم UserForm
* قم بإظهار صندوق الأدوات إذا لم يكن ظاهراً لديك من خلال قائمة View ثم Toolbox
* قم برسم أداة الليس بوكس ListBox كما هو موضح بالصورة التالية

* قم برسم أداة الصورة Image كما هو موضح بالصورة التالية

* الخطوة الأخيرة ضع الكود التالي في حدث الفورم (كليك يمين على اسم الفورم من نافذة المشروع ثم اختر View Code ثم الصق الكود)

Private Sub UserForm_Initialize()
    'الإعلان عن متغير من النوع نطاق
    Dim Rng As Range

    'لآخر خلية بالعمود [A2] تعيين قيمة للمتغير ليساوي النطاق من أول الخلية
    Set Rng = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

    'تعبئة الليست بوكس بقيم النطاق أي بالأسماء
    ListBox1.List = Rng.Value
End Sub

Private Sub listBox1_Click()
    'الإعلان عن المتغير من النوع النصي ليحمل مسار الصور
    Dim strPath         As String

    'تعيين مسار المجلد الذي يحتوي على الصور
    strPath = ThisWorkbook.Path & "\Photos\"

    'جملة لتجنب حدوث خطأ في حالة عدم وجود اسم معين
    On Error Resume Next

    'إظهار صورة في أداة الصورة ومسار الصورة كما هو موضح
    'يتم تحميل الصورة من مسار المجلد الذي يحتوي الصـور
    'مضاف إليه اسـم الصورة بالامتداد الخاص بها
    Image1.Picture = LoadPicture(strPath & ListBox1.Value & ".jpg")

    'في حالة عدم حدوث خطأ يتم الخروج من الإجراء هنا
    If Err = 0 Then Exit Sub

    'أما إذا حدث خطأ تظهر في أداة الصورة صورة يتم وضعها
    'تشير إلى أنه لا توجد صورة لهذا الشخص
    Image1.Picture = LoadPicture(strPath & "NoPhoto.Jpg")
End Sub


إعداد / ياسر خليل أبو البراء

الجمعة، 28 أكتوبر، 2016

أداة التحكم RefEdit لتحديد نطاق وكيفية استخدامها على الفورم Print Preview Using RefEdit Control

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

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




قم بإدراج فورم من قائمة Insert في محرر الأكواد ، ثم طبق الخطوات التالية كما في الصورة ، حيث يتم إدراج الأداة المسماة RefEdit1 ، وأيضاً إدراج زري أمر CommanButton1 و CommandButton2 أحدهما للمعاينة والآخر للطباعة

وأخيراً ضع الكود التالي في حدث الفورم (كليك يمين على الفورم من نافذة المشروع ثم اختر View Code)

Private Sub CommandButton1_Click()
    'تعريف المتغير من النوع نطاق
    Dim Rng As Range
    
    'إذا كانت قيمة الأداة فارغة يتم الخروج من الإجراء الفرعي تجنباً للخطأ
    If RefEdit1.Value = "" Then MsgBox "Cancelled", vbExclamation: Exit Sub
    
    '[RefEdit1] تعيين قيمة للنطاق ليساوي قيمة الأداة المسماة
    'حيث أن قيمة هذه الأداة تكون عبارة عن عنوان النطاق المحدد
    Set Rng = Range(RefEdit1.Value)
    
    'جملة للخروج من الفورم
    Unload Me
    
    'طباعة النطاق
    Rng.PrintOut
End Sub

Private Sub CommandButton2_Click()
    Dim Rng As Range
    
    If RefEdit1.Value = "" Then MsgBox "Cancelled", vbExclamation: Exit Sub
    Set Rng = Range(RefEdit1.Value)
    Unload Me
    
    'معاينة النطاق
    Rng.PrintPreview
End Sub


إعداد / ياسر خليل أبو البراء

دالة معرفة لدمج النصوص بمزايا مختلفة عن الدالة CONCATENATE الموجودة داخل الإكسيل MultiCat User Defined Function

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

أقدم لكم دالة معرفة UDF تقوم بدمج وجمع النصوص كما تفعل الدالة CONCATENATE ، ولكن مع اختلاف في النتائج ، حيث تتميز الدالة المعرفة بالحفاظ على تنسيق الخلايا التي يتم دمجها معاً.



وقد وضحت بالأمثلة في الملف المرفق معظم الحالات للدالة المعرفة ، وكيف أن النتائج تكون مختلفة عن الدالة CONCATENATE ، وأترككم مع الملف المرفق ومع الأمثلة التي توضح الفرق بينهما.

Public Function MultiCat(ByRef rRng As Excel.Range, Optional ByVal sDelim As String = "") As String
    Dim rCell As Range

    For Each rCell In rRng
        MultiCat = MultiCat & sDelim & rCell.Text
    Next rCell
    MultiCat = Mid(MultiCat, Len(sDelim) + 1)
End Function


إعداد / ياسر خليل أبو البراء

السبت، 8 أكتوبر، 2016

الشرح المستفيض لكود البحث المتقدم باستخدام المصفوفات للأستاذ الكبير ياسر العربي Search Using Arrays

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

 كود البحث المتقدم باستخدام المصفوفات VBA Arrays

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

وقد ارتأيت أن أقوم بشرح لأسطر الكود ليكون مرجع لكل طالب علم ولكل باحث في هذا الخصوص ، ولنبدأ مرحلة جديدة من عالم الأكواد باستخدام المصفوفات VBA Arrays ، لما لها من مرونة عالية وسرعة فائقة في تنفيذ الأكواد.

يوجد بالمرفق ورقتي عمل أحدهما باسم Data وفيها البيانات الخام من 14 عمود ، والورقة الأخرى باسم Result للنتائج وبها الخلية G2 والتي توضع بها نص الكلمة المراد البحث عنها.



وإليكم الكود مع الشرح بالتفصيل (وضعت مثال بسيط ليستطيع المتتبع للشرح فهم الكود بسهولة)

Sub Araby_Search()
    'تعريف المتغير لورقة العمل التي تحتوي على البيانات الخام
    Dim wsData As Worksheet

    'تعريف المتغير لورقة العمـل المطلـوب إظهـار النتائـج بها
    Dim wsResult As Worksheet

    'تعريف المتغير ليحمل قيم المصفـوفة للبيانات الخـام
    Dim Arr As Variant

    'تعريف المتغير ليحمل قيم المصفوفة للنتائج المطلوبة
    Dim Temp As Variant

    'تعريـف المتغير من النـوع النصي ليحمـل قيمة أو نص البحث
    'أي الكلمة المطلوب البحث عنها يتم تخزينها في هذا المتغير
    Dim strSearch As String
    
    'تعريف المتغير وسيستخدم في الحلقة التكرارية لصفوف المصفوفة
    Dim I As Long
    
    'تعريف المتغير وسيستخدم في الحلقة التكرارية لأعمدة المصفوفة
    Dim J As Long
    
    'تعريف المتغير وسيستخدم في مصفوفة النتائج لزيادة مقدار الصفوف بمقدار واحد
    Dim P As Long
    
    'تعيين قيمة للمتغير ليساوي ورقة العمل التي تحتوي
    '[Data] على البيانات الخام المطلوب معالجتها والمسماة
    Set wsData = Worksheets("Data")

    'تعيين قيمة للمتغير ليساوي ورقة العمل التي تريد إظهار
    '[G2] النتائج بها بمجرد إدخال قيمة أو نص محدد في الخلية
    Set wsResult = Worksheets("Result")
    
    'مسح النطاق الذي توضع فيه النتائج استعداداً لوضع النتائج الجديدة
    wsResult.Range("A8:N10000").ClearContents
    
    '[G2] تعيين قيمة للمتغير ليساوي قيمة الخلية
    'وهي الخلية التي ستوضع فيها نص الكلمة المطلوب البحث عنها
    strSearch = wsResult.Range("G2").Value
    
    'تعيين قيمـة للمتغير ليحمل قيم النطاق بالكامل للبيانات الخام
    ' وذلك [Data] حيث أن مصـدر البيانات الخام ورقة العمل المسماة
    'عند [N] وينتهي في العمود [A5] في النطاق الذي يبدأ من الخلية
    '[&] آخـر صف به بيانات ، ويتم تحديده عن طريـق الجزء بعد علامـة
    Arr = wsData.Range("A5:N" & wsData.Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    'والتي ستحمل قيم النتائج [Temp] إعادة تعيين أبعاد المصفوفة المسماة
    '[Arr] وتكون بنفس أبعاد المصفوفة التي تحمل البيانات الخام والمسماة
    'سنعتبر المصفوفة أشبـه بالصفـوف والأعمدة حيث الرقـم 1 يمثـل الصفـوف
    'بإرجاع أكبر قيمة [UBound]بينما الرقم 2 يمثل الأعمدة ، وتقوم الكلمة
    'أبعاد المصفوفة في هذه الحالة >>
    '-------------------------------
    'البعد الأول سيكون من 1 إلى أكبر قيمة للصفوف
    'البعد الثاني سيكون من 1 إلى أكبر قيمة للأعمدة
    ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
    
    'حلقة تكرارية من الصف الأول للمصفوفة إلى آخر صف بها
    For I = 1 To UBound(Arr, 1)
    
        'إذا كان النص المطلوب البحث عنه فارغ يتم الخروج من تنفيذ الكود
        If strSearch = "" Then Exit Sub
        
        'هذا السطر هو أهم سطر بالكود حيث هو الشرط الذي من خلاله
        'والشرط [Temp] ستوضع النتائج في مصفوفة النتائج المسماة
        'هـو تطابق قيمة المصفوفة في صف الحلقة في العمود رقم 14
        'حيث يمثـل الرقم 14 العمود داخـل مصفوفة البيانات الخام
        '[strSearch] يتـم اختبـار التطابـق مع نـص البحث المسمى
        If Arr(I, 14) Like "*" & strSearch & "*" Then
            
            'زيادة مقدار المتغير بمقدار 1
            'فائدة المتغير هنا هو أنه مع كل حلقة تكرارية
            'إذا تحقق الشرط فقط يزيد المتغير بمقدار واحد
            'ليمثل هذا المتغير صفوف مصفوفة النتائج الجديدة
            P = P + 1
            
            'حلقة تكرارية داخلية من العمود الأول للمصفوفة إلى آخر عمود بها
            For J = 1 To UBound(Arr, 2)
                
                'تعبئـة مصفـوفة النتائـج بالبيانات مـن مصفوفة البيانات الخام
                '[Temp]مثـال لتتضح صورة كيفية تعبئة المصفوفة الجديدة المسماة
                'في أول حلقـة سيكون مقداره 1 ويمثل أول صف [P] المتغيـر المسمى
                'أول صف هنا لمصفوفة النتائج
                'في أول حلقة سيكون مقداره 1 ويمثل أول عمود [J] المتغير المسمى
                'في أول حلقة سيكون مقداره 1 ويمثل أول صف [I] المتغير المسمى
                'أول صف هنا لمصفوفة البيانات الخام
                Temp(P, J) = Arr(I, J)
                
            'الانتقال للحلقة التالية للأعمدة
            Next J
        
        'نهاية جملة الشرط وهو تطابق نص البحث مع العمود رقم 14 في المصفوفة
        End If
    
    'الانتقال للحلقة التالية في صفوف مصفوفة البيانات الخام
    Next I
    
    'إذا كانت قيمة المتغير أكبر من صفر فهذا يعني أنه تم إيجاد نتائج للبحث
    'حيث أن زيادة المتغير كما أوضحنا مقرونة بتحقق الشرط وطالما تحقق الشرط
    'فهذا يعني أن مصفوفة النتائج سيكون بها بيانات ومن ثم يتحقق الجزء الثاني
    
    '[A8] وضع نتائج مصفوفة النتائج في أول خلية في ورقة النتائج في الخلية
    '[P] ويتم تمديد النطاق بمقدار عدد الصفوف طبقاً لقيمة المتغير المسمى
    '[Temp] وبمقدار عدد الأعمدة طبقاً لأكبر عدد لأعمدة المصفوفة المسماة
    If P > 0 Then wsResult.Range("A8").Resize(P, UBound(Temp, 2)).Value = Temp
End Sub

إعداد / ياسر خليل أبو البراء