- 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
Kod:
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
halbuki
Kod:
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 = 2067
End With
Set SutGen_hcr = Nothing
'*Satır Yüksekliği
Dim SatYuk_hcr As CommandBarControl
Set SatYuk_hcr = Application.CommandBars("Cell").Controls.Add
With SatYuk_hcr
.Caption = "Satır Y&üksekliği Cm"
.OnAction = "satir"
.FaceId = 2068
End With
Set SatYuk_hcr = Nothing
'*Değerleri Yapıştır
Dim DegYap_hcr As CommandBarControl
Set DegYap_hcr = Application.CommandBars("Cell").Controls.Add
With DegYap_hcr
.Caption = "&Degerleri yapistir..."
.OnAction = "Degerleri_Yapistir"
.FaceId = 662
.Tag = "MyTag"
End With
Set DegYap_hcr = Nothing
.............................
End Sub
Kod:
Sub SagTusKaldır()
'*hücrenin sağtuş menüsüne eklenen komutları kaldır
On Error Resume Next
'===================================================================
Application.CommandBars("Cell").Controls("Sütun &Genişliği Cm").Delete
Application.CommandBars("Cell").Controls("Satır Y&üksekliği Cm").Delete
Application.CommandBars("Cell").Controls("&Degerleri yapistir...").Delete
'===================================================================
Application.CommandBars("Row").Controls("Satır Y&üksekliği Cm").Delete
'===================================================================
Application.CommandBars("Column").Controls("Sütun &Genişliği Cm").Delete
End Sub