Excel Sağ Klik Menüsüne Ekleme yapmak değiştirmek

[kykbt]

Arkadaşlar Merhaba..

Sub Auto_Open()
Call ExceleSagKlikMenuEkle
End Sub

Sub ExceleSagKlikMenuEkle()
Application.CommandBars("Cell").Reset   'Sağ tık menü sıfırlanır
With Application.CommandBars("Cell").Controls
    With .Add
    .Caption = "Sayfa Koruma Kaldır"  'Eklemek istediğiniz menü başlığı
    .OnAction = ThisWorkbook.name & "!SayfaKorumaKaldır"  'Çalıştırmak istediğiniz makro adı
    .Tag = "SayfaKorumaKaldır"
    .BeginGroup = True  'Yeni grup
    End With
    With .Add
    .Caption = "Sayfa Koruma Yap"  'Eklemek istediğiniz menü başlığı
    .OnAction = ThisWorkbook.name & "!SayfaKorumaYap"  'Çalıştırmak istediğiniz makro adı
    .Tag = "SayfaKorumaYap"
    .BeginGroup = True  'Yeni grup
    End With
End With
End Sub

Private Sub SayfaKorumaKaldır()
ActiveSheet.Unprotect "00"
End Sub

Private Sub SayfaKorumaYap()
ActiveSheet.Protect "00"
End Sub

Sub Auto_Close()
    Application.CommandBars("Cell").Reset
End Sub

Şeklinde bir sağ klik menüsü ekliyorum.
Ancak ben aşağıdaki hale getirmek istiyorum. beceremedim..

Sub ExceleSagKlikMenuEkle()
Application.CommandBars("Cell").Reset
With Application.CommandBars("Cell").Controls
    With .Add
        .Caption = "Sayfa KorumaSIZDIR"
        'veya
        .Caption = "Sayfa KorumaLIDIR"
    End With
End With
End Sub

Sub ExceleSagKlikMenuDüzenle()
If ActiveSheet.ProtectContents Then
    ActiveSheet.Unprotect "00"
    With Application.CommandBars("Cell").Controls
    With .RENAME
        .Caption = "Sayfa KorumaSIZDIR"
    End With
End With
Else    'koruma yok
    ActiveSheet.Protect "00"
    With Application.CommandBars("Cell").Controls
    With .RENAME
        .Caption = "Sayfa KorumaLIDIR"
    End With
End If
End Sub

 

[Biolightant]

Merhaba,
İstediğiniz bu tarz bir şey mi ?

Private Sub Workbook_Open()
    On Error Resume Next
    ' Eklenen menüyü kaldır
    Application.CommandBars("Cell").Controls("Sayfa Koruması (Yap/Kaldır)").Delete
    On Error GoTo 0

    ' Hücre sağ tıklama menüsüne yeni bir seçenek ekle
    With Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton)
        .Caption = "&Sayfa Koruması (Yap/Kaldır)"
        .OnAction = "SayfaKorumaArtema" ' Menü öğesine tıklandığında çalışacak makro
        .BeginGroup = True ' Menüdeki diğer öğelerden ayırmak için
    End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    ' Eklenen menüyü kaldır
    Application.CommandBars("Cell").Controls("Sayfa Koruması (Yap/Kaldır)").Delete
    On Error GoTo 0
End Sub

Her hangi bir Modüle de

Sub SayfaKorumaArtema()

    ' Aktif sayfanın koruma durumunu kontrol eder
    If ActiveSheet.ProtectContents = True Then
        ActiveSheet.Unprotect "00"
    Else
        ActiveSheet.Protect "00"
    End If

End Sub

Not: Kodlar Excel 2013 TR de Çalıştı, Excel 2016 TR de Çalıştırmayı başaramadım

 

[Biolightant]

Kodları biraz geliştirdim.
hem Excel 2013 hemde Excel 2016 çalışıyor.

Private Sub Workbook_Open()
    Dim cb As CommandBar

    ' 424 ID'li Cell menüsünü bul ( ID si 427 olan Cell menüsü değil )
    For Each cb In Application.CommandBars
        If cb.ID = 424 Then
        
            On Error Resume Next
                ' Önceden eklenmiş menüyü kaldır (varsa)
                cb.Controls("Sayfa Koruması (Yap/Kaldır)").Delete
            On Error GoTo 0

            ' Yeni menü öğesi ekle
            With cb.Controls.Add(Type:=msoControlButton)
                .BeginGroup = True ' Menü öğelerini ayırmak için
                .FaceId = 893 ' Button un yanında gözükecek image
                .Caption = "Sa&yfa Korumayı (Yap/Kaldır)" ' Button gözüken yazı ve ismi ve [ Alt + y (access key)]
                .OnAction = "SayfaKorumaArtema" ' Tıklanınca çalışacak makro
            End With

            Exit For
        End If
    Next cb
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim cb As CommandBar

    ' 424 ID'li Cell menüsünü bul( ID si 427 olan Cell menüsü değil )
    For Each cb In Application.CommandBars
        If cb.ID = 424 Then
            On Error Resume Next
                ' Önceden eklenmiş menüyü kaldır
                cb.Controls("Sayfa Korumayı (Yap/Kaldır)").Delete
            On Error GoTo 0
            Exit For
        End If
    Next cb
End Sub

Her hangi bir Modüle de

Sub SayfaKorumaArtema()

    ' Aktif sayfanın koruma durumunu kontrol eder
    If ActiveSheet.ProtectContents = True Then
        ActiveSheet.Unprotect "00"
    Else
        ActiveSheet.Protect "00"
    End If

End Sub