Ply menüsünü şartlı olarak değiştirme

[hsayar]

General Declarations

Public wkb As Workbook                             '*wkb değişkeni tanımla
Public sh As Worksheet                              '*wkb değişkeni tanımla
Public SecilenWkb As Workbook                       '*Değişken tanımla
Public SecilenSh As Worksheet                       '*Değişken tanımla
Public arrSh()                                      'seçili sayfalar dizisi
Public cbWMB As CommandBar                          'WorksheetMenuBar
Public cbPLY As CommandBar                          'SayfaSekmeleriMenüsü
Public cbSEK As CommandBarControl                  'Yeni Komut Sayfa Ekle
Public cbSKP As CommandBarControl                  'Yeni Komut Sayfa Kopyala
Public cbSSL As CommandBarControl                  'Yeni Komut Sayfa Sil

Modul > Menü ekle prosodürü

Option Private Module
Sub PlySagTusEkle()
On Error Resume Next
Call PlySagTusKaldır
'_______________________________________________________________
Set cbPLY = CommandBars("Ply")
With cbPLY
    Set cbSEK = cbPLY.Controls.Add(msoControlButton)
    With .Controls.Add(msoControlButton)
         .Caption = "Sayfa Ekle ..."
         .FaceId = 2646
         .BeginGroup = True
         .OnAction = "SayfaEkle"
    End With
    Set cbSKP = cbPLY.Controls.Add(msoControlButton)
    With cbSKP
        .Caption = "Aktif Sayfayı Kopyala"
        .FaceId = 53
        .BeginGroup = False
        .OnAction = "AktSayfaKopyala"
    End With
    Set cbSKP = Nothing
    With .Controls.Add(Type:=msoControlButton, ID:=1561)
        .Visible = True
        .BeginGroup = True
    End With
   .Controls[color="red"]("")[/color].Delete       "bu boşluk neden oluşuyor bir türlü anlamadım, fikri olan varmı
End With

End Sub

Modul Menü kaldır

Sub PlySagTusKaldır()
'*hücrenin sağtuş menüsüne eklenen komutları kaldır
On Error Resume Next
'===================================================================
'Application.CommandBars("ply").Reset
Set cbPLY = CommandBars("Ply")
With cbPLY
    .FindControl(ID:=847).Delete
    .FindControl(ID:=889).Delete
    .FindControl(ID:=848).Delete
    .FindControl(ID:=1561).Delete
    .Controls("").Delete
    .Controls("Aktif Sayfayı Kopyala").Delete
    .Controls("Sayfa Ekle ...").Delete
End With
End Sub

Modul Çalışma Kitabı şifre kontrol

Sub CkKorumaKont()
Dim buCK As Workbook
Set buCK = ThisWorkbook
'ProtectContents
If buCK.ProtectWindows = False Then
MsgBox buCK.Name & " korumalıdır"
[color="Red"] Call PlyMenuekle [/color]
Else
MsgBox buCK.Name & " korumasızdır"
[color="Red"] Call PlyMenuKaldır [/color]
End If
End Sub

şeklinde tanımladığım menü ile istediğim komutları (ID leri bilinenler [bilinmeyenler,; Sekme rengi, Ekle...) kaldırp kendi komutlarımı koyuyorum

Ancak çalışma kitabı korumalı ise benim iki komutluk menüm (Kırmızı satırlar), değilse excel standart ply menüsü gelsin mümkünmü?

 

[hsayar]

Thisworkbook

'/////////////////////////////THISWORKBOOK\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Private Sub Workbook_Activate()
    'kitap çalıştığında ve Aktive edildiğine işlemler gerçekleşir
    'Call SifreKapa
    Call OzelmenuKaldır
    Call Ozelmenuekle
    Call PlySagTusKaldır
    Call PlySagTusEkle
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Auto closeden farkı ne anlamadım
    On Error Resume Next
    Call OzelmenuKaldır
    Call PlySagTusKaldır
End Sub
Private Sub Workbook_Deactivate()
'Bu kitaptan başka kitaba geçince yani DeAktive edildiğine işlemler gerçekleşir
    On Error Resume Next
    Call OzelmenuKaldır
    Call PlySagTusKaldır
End Sub

Sub Workbook_Close()
'*Kapanışta Makro çağır
    Call OzelmenuKaldır
    Call PlySagTusKaldır
End Sub

General Declarations

Public wkb As Workbook                             '*wkb değişkeni tanımla
Public sh As Worksheet                              '*wkb değişkeni tanımla
Public SecilenWkb As Workbook                       '*Değişken tanımla
Public SecilenSh As Worksheet                       '*Değişken tanımla
Public arrSh()                                      'seçili sayfalar dizisi
Public cbWMB As CommandBar                          'WorksheetMenuBar
Public cbPLY As CommandBar                          'SayfaSekmeleriMenüsü
Public cbSEK As CommandBarControl                  'Yeni Komut Sayfa Ekle
Public cbSKP As CommandBarControl                  'Yeni Komut Sayfa Kopyala
Public cbSSL As CommandBarControl                  'Yeni Komut Sayfa Sil

Modul > Menü ekle prosodürü

Option Private Module
Sub PlySagTusEkle()
On Error Resume Next
Call PlySagTusKaldır
Dim buCK As Workbook
Set buCK = ActiveWorkbook
    If buCK.ProtectStructure = True Then
'    MsgBox buCK.Name & "korumalıdır"
'_______________________________________________________________
'/////////////////SAYFA SEKME MENÜSÜNE\\\\\\\\\\\\\\\\\\\\\\\\|
    Set cbPLY = CommandBars("Ply")
    With cbPLY
        .FindControl(ID:=945).Delete           'Ekle...            945
        .FindControl(ID:=847).Delete           'Sayfa sil          847
        .FindControl(ID:=889).Delete           'Yeniden Adlandır   889
        .FindControl(ID:=848).Delete           '&Move or Copy...    848
        .FindControl(ID:=946).Delete           'Select All Sheets  946*
        .FindControl(ID:=5747).Delete          'Sekme Rengi...    5747
        .FindControl(ID:=1561).Delete          '&View Code  1561*
        
        With .Controls.Add(Type:=msoControlButton, ID:=946)
            .Visible = True
            .BeginGroup = False
        End With
    
        Set cbSEK = cbPLY.Controls.Add(msoControlButton)
        With .Controls.Add(msoControlButton)
             .Caption = "Sayfa Ekle ..."
            .FaceId = 2646
            .BeginGroup = False
            .OnAction = "SayfaEkle"
        End With
        Set cbSEK = Nothing
        
        Set cbSKP = cbPLY.Controls.Add(msoControlButton)
        With cbSKP
            .Caption = "Aktif Sayfayı Kopyala"
            .FaceId = 53
            .BeginGroup = False
            .OnAction = "AktSayfaKopyala"
        End With
        Set cbSKP = Nothing
        
        With .Controls.Add(Type:=msoControlButton, ID:=1561)
            .Visible = True
            .BeginGroup = False
        End With
        .Controls("").Delete
    End With
Else
'MsgBox buCK.Name & " korumasızdır"
    Call PlySagTusKaldır
End If
End Sub

Modul Menü kaldır

Sub PlySagTusKaldır()
On Error Resume Next
'===================================================================
Set cbPLY = CommandBars("Ply")
With cbPLY
'*Sayfasekme sağtuş menüsüne eklenen komutları kaldır
    .Controls("").Delete
    .FindControl(ID:=946).Delete
    .Controls("Aktif Sayfayı Kopyala").Delete
    .Controls("Sayfa Ekle ...").Delete
    .FindControl(ID:=1561).Delete          '&View Code  1561*
    .FindControl(ID:=945).Delete           'Ekle...            945
    .FindControl(ID:=847).Delete           'Sayfa sil          847
    .FindControl(ID:=889).Delete           'Yeniden Adlandır   889
    .FindControl(ID:=848).Delete           '&Move or Copy...    848
    .FindControl(ID:=946).Delete           'Select All Sheets  946*
    .FindControl(ID:=5747).Delete          'Sekme Rengi...    5747
    .FindControl(ID:=1561).Delete          '&View Code  1561*
'*Sayfasekme sağtuş menüsüne eklenen komutları yeniden ekle
    With .Controls.Add(Type:=msoControlButton, ID:=945)
        .Visible = True
        .BeginGroup = False
    End With
    With .Controls.Add(Type:=msoControlButton, ID:=847)
        .Visible = True
        .BeginGroup = False
    End With
    With .Controls.Add(Type:=msoControlButton, ID:=889)
        .Visible = True
        .BeginGroup = False
    End With
    With .Controls.Add(Type:=msoControlButton, ID:=848)
        .Visible = True
        .BeginGroup = False
    End With
    With .Controls.Add(Type:=msoControlButton, ID:=946)
        .Visible = True
        .BeginGroup = False
    End With
    With .Controls.Add(Type:=msoControlButton, ID:=5747)
        .Visible = True
        .BeginGroup = True
    End With
    With .Controls.Add(Type:=msoControlButton, ID:=1561)
        .Visible = True
        .BeginGroup = True
    End With
End With
End Sub
'Resetlemedim çünkü eklentideki ply menülerni öldürmek istemedim. bunlar bu kitaba özel.

Biraz uğraştırdı örnek dosyalarla halletim. Yukarıdaki Kodlar ile çalışma kitabının koruması kalktıktan sonra Başka kitapa geçip yeniden bu kitaba döndüğümde excelin kendi menüsü Koruma koyduktan sonra benim hazırladığım menü geliyor.

Ancak koruma durumu değişir değişmez eş zamanlı olarak gelmesi için ne yapmalıyım