Onaction Düzgün Çalışmıyor

[rotring05]

Merhabalar,
Aşağıda yer alan kodlar ile sağ tıklama menüsünde "Çalışma Sayfasına Git" Pop-up'ı yaratıp bunun altında çalışma kitabımdaki çalışma sayfalarını listelemeyi ve bu listede istediğim çalışma sayfasının butonuna basarak o sayfaya gitmek istiyorum.

Public i As Integer, Ctrl As CommandBarControl, AltMenu As CommandBarPopup, ContextMenu As CommandBar

Sub KısayolEkleme()
CommandBars("Cell").Reset
i = 1
Set ContextMenu = Application.CommandBars("Cell")
Set AltMenu = ContextMenu.Controls.Add(Type:=msoControlPopup)
With AltMenu
.Caption = "Çalışma Sayfasına Git"
Call SayfayaGit
Do Until i = Worksheets.Count
Set Ctrl = AltMenu.Controls.Add(Type:=msoControlButton)
Ctrl.Caption = Sheets(i).Name
Ctrl.OnAction = "'" & ThisWorkbook.Name & "'!" & "SayfayaGit"
i = i + 1
Loop
End With
End Sub


Public Sub SayfayaGit()
Sheets(i).Select
End Sub

Listede sonuncu çalışma sayfam gözükmüyor ve bu listede hangi butona tıklarsam tıklayayım hep en sonda yer alan çalışma sayfama gidiyor.

Konuyu çok araştırdım ancak bir sonuç elde edemedim.
Yardımlarınız için şimdiden teşekkürler.

 

[Muzaffer Ali]

Aşağıdaki kodları kullanın

Sub KısayolEkleme()
    CommandBars("Cell").Reset
    i = 1
    Set ContextMenu = Application.CommandBars("Cell")
    Set AltMenu = ContextMenu.Controls.Add(Type:=msoControlPopup)
    With AltMenu
    .Caption = "Çalışma Sayfasına Git"
    'Call SayfayaGit
    Do Until i = Worksheets.Count
    Set Ctrl = AltMenu.Controls.Add(Type:=msoControlButton)
    Ctrl.Caption = Sheets(i).Name
    Ctrl.OnAction = "'" & ThisWorkbook.Name & "'!" & "'SayfayaGit(" & i & ")'"
    i = i + 1
    Loop
    End With
End Sub


Public Sub SayfayaGit(SYF)
    Sheets(SYF).Select
End Sub

 

[rotring05]

Çok teşekkür ederim. Umarım mantığını çözerim.