(If Not c Is Nothing Then) şeklinde sağ tuş menüsüne ilave

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
'===============================HÜCREYE MENÜ EKLE/KALDIR
Sub SagTusEkle()
On Error Resume Next
Call SagTusKaldır
'_______________________________________________________________
'/////////////////HÜCRE SAĞTUŞ MENÜSÜNE\\\\\\\\\\\\\\\\\\\\\\\\|

'Sütun Genişliği
Dim SutGen_hcr As CommandBarControl
Set SutGen_hcr = Application.CommandBars("Cell").Controls.Add
    With SutGen_hcr
        .Caption = "Sütun &Genişliği Cm"
        .OnAction = "sutun"
        .FaceId = 7
    End With
Set SutGen_hcr = Nothing
......................
Kod:
Sub BicimeEkle()
'******************************************************
On Error Resume Next
'ReDim Preserve wrbk(1)
'Set wrbk(1).wrbk = Excel.Application
'******************************************************
'   With CommandBars(1).Controls.Add(msoControlPopup)

Dim c As CommandBar
Dim cb As CommandBarButton
Dim cp As CommandBarPopup
Set c = Application.CommandBars("Worksheet Menu Bar")   '1
    If Not c Is Nothing Then
        Set cp = c.Controls(5)  'Biçim(ingilizcesi) Menüsü
        'Set cp = c.Controls(6)  'Araçlar (Tools) Menüsü
            If Not cp Is Nothing Then
                Set cb = cp.Controls.Add(msoControlButton)
                cb.Tag = "BuyukKuçukHarf"          'Excel 2k3 WizardApp
                cb.Style = msoButtonCaption
                cb.Caption = "Büyük/Küçük &Harf Değiştir"
                cb.OnAction = "Goster_ufBKHD"
            End If
    End If
Status = False
'Call ParametreYükle
Set c = Nothing
Set cb = Nothing
Set cp = Nothing
'******************************************************
End Sub
nasıl yazarım. çünkü sebebini bilmediğim bir şekilde (Diğer tüm eklentileri kaldırdığım halde) eklediğim menüler sağtuştan kalkıyor.
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Option Private Module
'Dim wrbk() As New Class1
Sub HucreSE()
'******************************************************
On Error Resume Next

Dim HCR As CommandBar
Dim BKH As CommandBarButton
'Dim cp As CommandBarPopup
Set HCR = Application.CommandBars("Cell")
If Not HCR Is Nothing Then
    Set BKH = HCR.Controls.Add(msoControlButton)
    If Not BKH Is Nothing Then
        With BKH
          .Tag = "BuyukKuçukHarf"
          .Style = msoButtonCaption
          .Caption = "BÜYÜK/Küçük &Harf Değiştir"
          .OnAction = "Goster_ufBKHD"
          .FaceId = 476
        End With
    End If
End If
Status = False

Set HCR = Nothing
Set BKH = Nothing
'******************************************************
End Sub

Sub HucreSK()
Dim HCR As CommandBar
Dim BKH As CommandBarButton
On Error Resume Next
Set HCR = Application.CommandBars("Cell")
    If Not HCR Is Nothing Then

        Set BKH = HCR.FindControl(, , "BuyukKuçukHarf", , True)
            Do While Not BKH Is Nothing
            BKH.Delete
            Set BKH = HCR.FindControl(, , "BuyukKuçukHarf", , True)
            Loop
    End If
Set HCR = Nothing
Set BKH = Nothing
End Sub
şeklinde halletim ancak bu tip yazımda face idler gözükmüyo neden acaba
 
Üst