- 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