Yeni Menü Ekleme ve Menüyü Yenileme

[arifyilmazer]

Arkadaşlar Sayfaları gösteren bir menü oluşturdum sayfaları buradan seçiyorum. Dosyayı açınca, yeni sayfa ekleyince, sağ tuş yapınca sayfayı yeniliyorum ama sayfa ismini değiştirince ve sayfa silince de yineleme işlemi yapsın istiyorum ama beceremedim. Bi göz atabilir misiniz? Tablo ekte

 

[arifyilmazer]

Böyle bişey yaptım ama yine istediğim gibi değil başka bir yenileme butonu oluşturuyor
Sub Autpen()

Auto_Close

Dim ActiveMenuListe As CommandBar

Dim Menu As CommandBarPopup

Dim cSayfa As CommandBarControl

Dim cYenile As CommandBarControl



Set ActiveMenuListe = CommandBars.ActiveMenuBar

Set Menu = ActiveMenuListe.Controls.Add(Type:=msoControlPopup, Temporary:=True)

Set cYenile = ActiveMenuListe.Controls.Add(Type:=msoControlButton, Before:=ActiveMenuListe.Controls.Count + 1, Temporary:=True)



cYenile.Caption = "Yenile"

cYenile.OnAction = "Autpen"

cYenile.FaceId = 250

Menu.Caption = "&Sayfa Seç"



With ActiveMenuListe.Controls("Sayfa Seç")

.BeginGroup = True

.TooltipText = "Sayları seçer"

For i = 1 To Worksheets.Count

Set cSayfa = .Controls.Add(Type:=msoControlButton)

With cSayfa

.Caption = Worksheets(i).Name

.OnAction = "SayfaSec"

.FaceId = 1200 + i

.Tag = i

End With

Next



End With



Set ActiveMenuListe = Nothing

Set Menu = Nothing

Set cSayfa = Nothing

End Sub



Sub Auto_Close()
'****************************************************************************
'Context menüye eklenen komutu siler.
Application.CommandBars(1).Reset
'****************************************************************************

'****************************************************************************
'Reset komutu çalışmazsa aşağıdaki kodlar aktif yapılacak
' Dim cb As CommandBar, i As Integer
' Set cb = Application.CommandBars("Cell")
'
' For i = cb.Controls.Count To 1 Step -1
' If cb.Controls(i).Caption = "Bankalar" Then
' cb.Controls(i).Delete
'' Exit For
' End If
' Next
'****************************************************************************
End Sub


Sub SayfaSec()
On Error Resume Next
Worksheets(CommandBars.ActionControl.Caption).Select
End Sub

Sub Sayfa_Sırala()

Dim i As Integer, j As Integer



If Worksheets.Count = 1 Then Exit Sub



For i = 1 To Worksheets.Count - 1

For j = i + 1 To Worksheets.Count

Debug.Print Worksheets(j).Name & " < " & Worksheets(i).Name

If Worksheets(j).Name < Worksheets(i).Name Then Worksheets(j).Move Before:=Worksheets(i)


Next j

Next i

End Sub

 

[arifyilmazer]

arkadaşlar bi bakarsanız sevinirim....Teşekkür ederim şimdiden

 

[ec2000]

Çözüm

Dostum ThisWorkbook modülüne alttaki komutları eklersen sorunun halledilir diye düşünüyorum.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Dim SayfaAdi As String
    SayfaAdi = InputBox("Sayfa Adı:")
    Sh.Name = SayfaAdi
    Auto_Open
End Sub

Olmazsa başka biryol düşeneceğiz artık.
Kolay gelsin

 

[arifyilmazer]

Dostum ThisWorkbook modülüne alttaki komutları eklersen sorunun halledilir diye düşünüyorum.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Dim SayfaAdi As String
    SayfaAdi = InputBox("Sayfa Adı:")
    Sh.Name = SayfaAdi
    Auto_Open
End Sub

Olmazsa başka biryol düşeneceğiz artık.
Kolay gelsin

Ec 2000 teşekür ederim evet sayfa adı değişimini bu şekilde hallederiz peki sayfa silince nasıl yineleme yapabiliriz?