Kontextmenü anpassen. Code vorhanden
21.11.2022 13:05:49
Gula
ich möchte mein Kontextmenü bei einem Rechtsklick anpassen. Ich habe im Internet auch einen Code gefunden, der funktioniert.
Nun ist es so, dass im Kontextmenü "Kopieren" und "Einfügen" steht. Sowei so gut. Ist es möglich, dass dort anstatt Einfügen die Einfügeoption "Keine Rahmenlinie" aufgeführt wird? Die kleine Box bei einem Rechtsklick, wo man die Schriftart, Größe, Zellefüllfarbe etc. einstellen kann wird auch nicht mehr angezeigt. Lässt sich die wieder einblenden? Ich denke, das diese Anpassungen wohl in dem eigentlichen Modul (letzter Code hier) zu machen sind, aber ich hab überhaupt keine Ahnung davon.
Hier die Datei, die ich als Beispiel erstellt habe. https://www.herber.de/bbs/user/156293.xlsx
Grüße und Danke schon mal.
Diese Arbeitsmappe:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not Saved Then
Select Case MsgBox("Sollen Ihre Änderungen in '" & Name & _
"' gespeichert werden", vbExclamation Or vbYesNoCancel)
Case vbYes
Save
Case vbNo
Saved = True
Case vbCancel
Cancel = True
End Select
End If
If Not Cancel Then Call DeleteCommandbar
End Sub
Private Sub Workbook_Open()
Call CreateCommandbar
End Sub
Modul der Tabelle:
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
CommandBars(COMMANDBAR_CELL).ShowPopup
End Sub
Modul:
Option Explicit
Option Private Module
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" ( _
ByVal wFormat As Long) As Long
Private Const CF_TEXT As Long = 1
Public Const COMMANDBAR_CELL As String = "Copy&Paste"
Public Sub CreateCommandbar()
Dim objCommandBar As CommandBar
Dim objCommandBarButton As CommandBarButton
Call DeleteCommandbar
Set objCommandBar = CommandBars.Add(Name:=COMMANDBAR_CELL, _
Position:=msoBarPopup, Temporary:=True)
Set objCommandBarButton = objCommandBar.Controls.Add( _
Type:=msoControlButton)
With objCommandBarButton
.Caption = "Kopieren"
.OnAction = "CopyFromRange"
.FaceId = 19
End With
Set objCommandBarButton = objCommandBar.Controls.Add( _
Type:=msoControlButton)
With objCommandBarButton
.Caption = "Einfügen"
.OnAction = "PasteInRange"
.FaceId = 22
End With
Set objCommandBarButton = Nothing
Set objCommandBar = Nothing
End Sub
Public Sub DeleteCommandbar()
Dim objCommandBar As CommandBar
For Each objCommandBar In CommandBars
If objCommandBar.Name = COMMANDBAR_CELL Then _
objCommandBar.Delete
Next
End Sub
Public Sub CopyFromRange()
Call Selection.Copy
End Sub
Public Sub PasteInRange()
If IsClipboardFormatAvailable(CF_TEXT) = 1 Then
Call ActiveCell.PasteSpecial(Paste:=xlPasteValues)
Else
Call Beep
End If
End Sub