السلام عليكم
يوجد لدي كود يعمل في صفحه الحدث
الرجاء جعله يكون كود بحيث ان يتم العمل به عند اللزوم وليس كل مره ادخل الصفحه يقوم بالتحديث ويأخد وقت
Option Explicit
Dim check%
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Columns(1)) Is Nothing _
And Target.Count = 0 Then
Call IsHyperlink(Target)
If check Then
Sheets(Target & "").Visible = True
Target.Hyperlinks(1).Follow
End If
End If
Application.EnableEvents = True
End Sub
Sub IsHyperlink(r As Range)
check = r.Hyperlinks.Count
End Sub
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim l As Long
l = 1
With Me
.Columns(1).ClearContents
.Cells(1, 1) = "اسماء المنتجات"
.Cells(1, 1).Name = "Index"
End With
For Each wSheet In Worksheets
If wSheet.Name <> Me.Name Then
l = l + 1
With wSheet
.Range("A1").Name = "Start" & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("d1"), Address:="", SubAddress:= _
"Index", TextToDisplay:="الرئيسية"
End With
Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", _
SubAddress:="Start" & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
With Me.Range("A:A").Font
.ColorIndex = xlAutomatic
.Bold = True: .Underline = 1
.Name = "Arial": .Size = 12
End With
End Sub
المصنف1.xlsm