Einfügen Spezial - Tastenkombination und Kontextmenü...

OptionExplicit
PrivateSubWorkbook_Open()
' Dieser Befehl kann nur genutz werden, wenn das Kontextmenü
' NICHT verändet wurde, denn der haut auch eigene Einträge raus.
' In dem Fall müsste das Kontextmenü vorher ausgelesen werden
' und beim Schliessen (Deaktivieren) der Mappe
' wieder eingespielt werden.
Application.CommandBars("Cell").Reset
' Das Kontextmenü wird angepasst
Context_Menu
' Die Tastenkombination "ALT+Q" wird auf ein Makro gelegt
Application.OnKey"%{q}","Module1.InsertS"
EndSub
PrivateSubWorkbook_Activate()
Application.CommandBars("Cell").Reset
Context_Menu
Application.OnKey"%{q}","Module1.InsertS"
EndSub
PrivateSubWorkbook_Deactivate()
' Die Tastenkombination "ALT+Q" wird auf den Ursprung gesetzt
Application.OnKey"%{q}"
Application.CommandBars("Cell").Reset
EndSub

' Variablendeklaration erforderlich
OptionExplicit
' Public Subs werden im Makrofenster "ALT+F8" NICHT angezeigt
OptionPrivateModule
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : InsertS
' Author    : Case (Ralf Stolzenburg)
' Date      : 16.10.2013
' Purpose   : Einfügen Spezial - Tastenkombination und Kontextmenü...
'--------------------------------------------------------------------------
SubInsertS()
' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
WithApplication
' Das Bildschirmaktualisierung wird unterbrochen
.ScreenUpdating=False
' Ereignisroutinen werden deaktiviert
.EnableEvents=False
'  Eingabeaufforderungen und Warnmeldungen unterdrücken
.DisplayAlerts=False
EndWith
' Es gibt nichts zum einfügen - also mach weiter
OnErrorResumeNext
Cells(ActiveCell.Row,ActiveCell.Column).PasteSpecial_
Paste:=xlPasteValues,SkipBlanks:=True
' Schaltet alle Errorhandler aus
OnErrorGoTo0
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
OnErrorGoToFin
Fin:
' Die Applikation aufwecken
WithApplication
' Bildschirmaktualisierung wieder einschalten
.ScreenUpdating=True
' Ereignisroutinen werden wieder aktiviert
.EnableEvents=True
' Eingabeaufforderungen und Warnmeldungen wieder zulassen
.DisplayAlerts=True
' Abbrechen Ausschneide- bzw. Kopiermodus und entfernen des Laufrahmens
.CutCopyMode=True
EndWith
' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : Context_Menu
' Author    : Case (Ralf Stolzenburg)
' Date      : 16.10.2013
' Purpose   : Einfügen Spezial - Tastenkombination und Kontextmenü...
'--------------------------------------------------------------------------
PublicSubContext_Menu()
' Variablendeklaration
DimobjCommandBarButtonAsCommandBarButton
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
OnErrorGoToFin
' Ein neuer temporärer Eintrag im Kontextmenü der Zellen an 6ter Stelle
SetobjCommandBarButton=CommandBars("Cell").Controls.Add(msoControlButton,,,5,True)
' Was soll da stehen und was soll beim draufklicken passieren
WithobjCommandBarButton
.Caption="Very Special..."
.OnAction="InsertS"
EndWith
Fin:
' Setze die Objektvariable auf Nothing
SetobjCommandBarButton=Nothing
' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub