DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Auto_Open()
Dim cb As CommandBar
Set cb = Application.CommandBars("Cell")
Set MenuObject = cb.Controls.Add(Type:=msoControlButton, Temporary:=True)
With MenuObject
.BeginGroup = True
.Caption = Application.CommandBars.FindControl(ID:=755).Caption & " Values"
.OnAction = "PasteValues"
End With
Application.MacroOptions Macro:="PasteValues", _
HasShortcutKey:=True, _
ShortcutKey:="Z"
Set MenuObject = Nothing
End Sub
'
Sub PasteValues()
On Error Resume Next
Selection.PasteSpecial Paste:=xlValues
End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)
Call CheckEnabled
End Sub
Public cb As CommandBar
Public MenuObject As CommandBarControl
Public MyIndex
'
Sub Auto_Open()
Set cb = Application.CommandBars("Cell")
Set MenuObject = cb.Controls.Add(Type:=msoControlButton, Temporary:=False)
With MenuObject
.BeginGroup = True
.Caption = Application.CommandBars.FindControl(ID:=755).Caption & GetCaptExt
.OnAction = "PasteValues"
.Tag = "PasteSpecialValuesTag"
MyIndex = .Index
End With
Application.MacroOptions Macro:="PasteValues", _
HasShortcutKey:=True, _
ShortcutKey:="Z"
Set MenuObject = Nothing
End Sub
'
Sub PasteValues()
On Error Resume Next
Selection.PasteSpecial Paste:=xlValues
End Sub
'
Function GetCaptExt() As String
Select Case Application.LanguageSettings.LanguageID(msoLanguageIDInstall)
Case msoLanguageIDEnglishUS
CaptExt = " Values"
Case msoLanguageIDTurkish
CaptExt = " Değerler"
Case Else
CaptExt = " "
End Select
GetCaptExt = CaptExt & Space(2) & Chr(174)
End Function
'
Sub CheckEnabled()
On Error Resume Next
cb.Controls(MyIndex).Enabled = Application.CommandBars.FindControl(ID:=755).Enabled
End Sub
'
Sub Auto_Close()
On Error Resume Next
cb.Controls(MyIndex).Delete
Application.MacroOptions Macro:="PasteValues", HasShortcutKey:=False, _
ShortcutKey:=Empty
End Sub
Sub ResetPopUpMenu()
Application.CommandBars("Cell").Reset
End Sub
Eğer bu yeni menüyü bütün çalışma kitaplarında kullanmak isterseniz, kodu yerleştirdiğiniz dosyayı Microsoft Excel Add-In (*.xla) olarak kaydedin. Bu eklentiyi Excel'e tanıttıktan sonra, bütün Excel dosyalarında kullanabilirsiniz
öncelikle excelde pastespecial kısayolu olmaması büyük eksiklik.
Teşekkür ederim ExelanslarıCazador'u bizi uykudan uyandırdığı için bir kez daha tebrik ederim.