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



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



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


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

رابط الملف من هنا

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