Sayfaları Menü Halinde Gösterme

[janveljan]

Belgedeki sayfaları menu halinde gösteren ve menüden ilgili sayfa seçilince o sayfayı açan kodlar.

Sub auto_open()
  Dim AnaMenu As CommandBarControl
  Set AnaMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
  With AnaMenu
    .Caption = "Sayfalar"
    .BeginGroup = False
  End With
  For i = 1 To ActiveWorkbook.Sheets.Count
  With AnaMenu.Controls.Add(msoControlButton, 1, , , True)
    .Caption = Sheets(i).Name
    .OnAction = "sayfaac"
  End With
  Next
End Sub
Sub sayfaac()
    Sheets(Application.CommandBars.ActionControl.Caption).Select
End Sub
Sub auto_close()
    Application.CommandBars("Worksheet Menu Bar").Reset
End Sub

 

[ersoyalan]

Merhaba,

Kodları örnek bir dosyaya ekleyip gönderirmisin.

E.ALAN

 

[janveljan]

Dosya ekte

 

[kykbt]

Arkadaşlar Merhaba
janveljan hocamın kodlarını aşağıdaki gibi düzenleyerek ....xla dosyasına koyarak Addins klasörüne koydum.
Böylece her Excel dosyasında kullanılır oldu.

'Sub auto_opennn()
'Call CommandBarsMenüSayfalarX
'End Sub

Sub CommandBarsMenüSayfalarX()
On Error Resume Next
Application.CommandBars(1).Controls("Sayfalar").Delete
'Application.CommandBars(1).Controls("Sayfalar").Clear
On Error GoTo 0
Dim AnaMenu As CommandBarControl
Set AnaMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
With AnaMenu
    .Caption = "Sayfalar"
    .BeginGroup = False
End With
With AnaMenu.Controls.Add(msoControlButton, 1, , , True)
    .Caption = "Sayfalar Listesi"
    .OnAction = "CommandBarsMenü_SayfalarıListeleX"
End With
End Sub

Sub CommandBarsMenü_SayfalarıListeleX()
Application.CommandBars(1).Controls("Sayfalar").Delete
Dim AnaMenu As CommandBarControl
Set AnaMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
With AnaMenu
    .Caption = "Sayfalar"
    .BeginGroup = False
End With
With AnaMenu.Controls.Add(msoControlButton, 1, , , True)
    .Caption = "**Listeyi Gizle**"
    .FaceId = 22
    .OnAction = "CommandBarsMenüSayfalarX"
End With
For i = 1 To ActiveWorkbook.Sheets.count
  With AnaMenu.Controls.Add(msoControlButton, 1, , , True)
    .Caption = Sheets(i).name
    .FaceId = 7438
    .OnAction = "Sayfayı_AçX"
  End With
Next
End Sub

Sub Sayfayı_AçX()
    Sheets(Application.CommandBars.ActionControl.Caption).Select
End Sub

yukarıdaki kod da

' Application.CommandBars(1).Controls("Sayfalar").Delete yerine
aşağıdaki koodu çalıştırmak istiyorum.
'Application.CommandBars(1).Controls("Sayfalar").Clear

Yani menüyü silmek yerine, silmeden içeriğini değiştirmek istiyorum.
yardımlarınıza ihtiyacım var.

ayrıca menü listesini açık olarak bırakmak ta mümkünmüdür..
'.Caption = "**Listeyi Gizle**"
'.OnAction = "CommandBarsMenüSayfalarX"

Listeyi Gizle İle Liste uzayıp kısalmalı gibi

'.Caption = "**Listeyi Göster**"
'.OnAction = "CommandBarsMenüSayfalarX"

Mümkün ise..

 

[kykbt]

Hocalarım Merhaba
Bu konuda yapılabilecek bir şey varmı acaba..??
Yani aynı menü içinde değişiklik için ne yapılabilir.?
Oluşturduğum menüyü kod ile çağırabilsem belki bir şeyler yapabileceğim gibi..

 

[Biolightant]

Merhaba,

xlam dosyasına koyarak Addins klasörüne koydum.

Dosyayı Eklenti *.xlam yapınca menüde problemler oluşuyor.

1. Problem :

ActiveWorkbook.Sheets.Count satırında problem oluşturuyor​

çünkü *.xlam dosyalarında Sayfa (Worksheet) olmaz.​

olsa da işimize yaramaz biz onun sayfa listesini değil Aktif olan sayfa listesini istiyoruz.​

2. Problem:

Kullanıcı Yeni bir Sayfa Eklediğinde, Sildiğinde, Ad Değiştirdiğinde​

Hatta Yeni Excel Kitabı daha açtığında ( 2 veya daha fazla kitap açık durumda)​

Menünün Güncellenmesi gerekmekte.​

xlsm Dosya Linki: MenuSayfalar.xlsm

xlam Dosya Linki: MenuSayfalar.xlam


BuÇalışmaKitabı na yazılacak kodlar :

Option Explicit
' Biolight 2025 - Eppur Si Muove

' Eklenti açıldığında menüyü oluşturur
Private Sub Workbook_Open()
    Dim AnaMenu As CommandBarControl

    ' Eğer "Sayfalar" menüsü zaten varsa, yeniden ekleme
    On Error Resume Next
        Set AnaMenu = Application.CommandBars("Worksheet Menu Bar").Controls("Sayfalar")
    On Error GoTo 0

    If AnaMenu Is Nothing Then
        ' Menü yoksa oluştur
        Set AnaMenu = Application.CommandBars("Worksheet Menu Bar").Controls.Add(msoControlPopup, , , , True)
        With AnaMenu
            .Caption = "Sayfalar"
            .BeginGroup = False
            .OnAction = "MenuYenile"
        End With
    End If
   
    ' Workbook değiştiğinde menüyü güncelle
    Application.OnWindow = "MenuYenile"
End Sub

' Eklenti kapatıldığında menüyü siler
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
        Application.CommandBars("Worksheet Menu Bar").Controls("Sayfalar").Delete
    On Error GoTo 0
End Sub

Modüle yazılacak kodlar :

Option Explicit
' Biolight 2025 - Eppur Si Muove

' Menüdeki sayfaları aktif kitaba göre yeniler
Sub MenuYenile()
    Dim cmbPopup As CommandBarControl
    Dim cmbButton As CommandBarControl
    Dim ws As Worksheet

    ' "Sayfalar" menüsünü bul
    On Error Resume Next
    Set cmbPopup = Application.CommandBars("Worksheet Menu Bar").Controls("Sayfalar")
    On Error GoTo 0

    ' Eğer menü yoksa çık
    If cmbPopup Is Nothing Then Exit Sub

    ' Önce eski sayfa butonlarını sil
    Do While cmbPopup.Controls.Count > 0
        cmbPopup.Controls(1).Delete
    Loop

    On Error Resume Next
    ' Eğer aktif bir çalışma kitabı varsa sayfaları ekle
    If Not ActiveWorkbook Is Nothing Then
        For Each ws In ActiveWorkbook.Sheets
            Set cmbButton = cmbPopup.Controls.Add(Type:=msoControlButton)
            With cmbButton
                .Caption = ws.Name
                .OnAction = "SayfaAC"
                .FaceId = 8
            End With
        Next
    End If
    On Error GoTo 0
   
End Sub

' Menüden seçilen sayfayı açar
Sub SayfaAC()
    On Error Resume Next
        Sheets(Application.CommandBars.ActionControl.Caption).Select
    On Error GoTo 0
End Sub