Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1872to1876
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Eigenes Kontextmenü, Veränderung

Eigenes Kontextmenü, Veränderung
24.02.2022 07:15:30
Flo
Guten Morgen,
Ich habe in meiner Datei ein eigenes erstelltes Kontextmenü, beziehe die Daten aus einem gewissen Tabellenblatt. Dort stehen links die Kürzel und rechts die Daten.
Bisher werden im Kontextmenü nur die Namen angezeigt Bsp.: Mobiles Arbeiten. Ich möchte aber das es zum Beispiel so angezeigt wird : MA = Mobiles Arbeiten
Der Code lautet:

Public Sub CreateCommandBar()
Dim objCommandBar As CommandBar
Dim objCommandBarButton As CommandBarButton
Dim objName As Name
Dim lngIndex As Long
Call DeleteCommandBar
Set objCommandBar = CommandBars.Add(Name:=CONTEXT_MENU, _
Position:=msoBarPopup, Temporary:=True)
For lngIndex = 1 To 25
For Each objName In ThisWorkbook.Names
If objName.Name = "AbwK" & CStr(lngIndex) Then Exit For
Next
If Not objName Is Nothing Then
If Not IsError(Evaluate(objName.RefersTo)) Then
If Not IsEmpty(Range(objName.Name).Value) Then
Set objCommandBarButton = objCommandBar.Controls.Add(Type:=msoControlButton)
With objCommandBarButton
.Caption = Range(objName.Name).Value
.OnAction = "'Färbe """ & Replace$(objName.Name, "K", "Kk") & """'"
End With
End If
End If
End If
Next
Set objCommandBarButton = Nothing
Set objCommandBar = Nothing
Set objName = Nothing
End Sub
Ich hoffe das reicht an Information ansonsten, gerne Bescheid geben und danke für die Hilfe!
VG
Flo

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Eigenes Kontextmenü, Veränderung
24.02.2022 08:39:34
Piet
Hallo
du kannst es so machen, indem du nur diese Zeile änderst: - .Caption = "MA = " & Range(objName.Name).Value
Wenn es statt "MA" noch weitere Kürzel gibt kannst du sie vorher als Text Variable festlegen, z.B. in der Art:
If lngIndex >= 1 and lngIndex If lngIndex >= 6 and lngIndex .Caption = "Txt = " & Range(objName.Name).Value
mfg Piet
AW: Eigenes Kontextmenü, Veränderung
24.02.2022 08:56:52
Flo
Danke erstmal,
gibt es zufällig die Möglichkeit über die Namensfelder zu machen?
Habe die ganzen Kürzel benannt mit AbwKk1 - 30 und die ausgeschriebenen Beschreibungen mit AbwK1-30 .
Bei deiner Methode müsste ich 30 Cases machen oder ?
VG
Flo
Anzeige
AW: Eigenes Kontextmenü, Veränderung
24.02.2022 11:22:38
Rudi
Hallo,
teste mal:

Public Sub CreateCommandBar()
Dim objCommandBar As CommandBar
Dim objCommandBarButton As CommandBarButton
Dim objName As Name
Dim lngIndex As Long
Dim strNameKk As String, strNameK As String
' Call DeleteCommandBar
Set objCommandBar = CommandBars.Add(Name:=CONTEXT_MENU, _
Position:=msoBarPopup, Temporary:=True)
For lngIndex = 1 To 30
strNameKk = "AbwKk" & lngIndex
strNameK = "AbwK" & lngIndex
Set objCommandBarButton = objCommandBar.Controls.Add(Type:=msoControlButton)
With objCommandBarButton
.Caption = [strNameKk] & "=" & [strNameK]
.OnAction = "'Färbe """ & [strNameKk] & """'"
End With
Next
Set objCommandBarButton = Nothing
Set objCommandBar = Nothing
Set objName = Nothing
End Sub

Anzeige
AW: Eigenes Kontextmenü, Veränderung
24.02.2022 11:44:55
Flo
Wir kommen der Sache schon näher mit dem = .
Das Ganze sieht jetzt so aus:
Userbild
VG
Flo
AW: Eigenes Kontextmenü, Veränderung
24.02.2022 12:00:30
Rudi
beziehen sich deine Namen auf Zellen? Dann so:

With objCommandBarButton
.Caption = Names(strNameKk).RefersToRange & "=" & Names(strNameK).RefersToRange
.OnAction = "'Färbe """ & Names(strNameKk).RefersToRange & """'"
End With
Gruß
Rudi
AW: Eigenes Kontextmenü, Veränderung
24.02.2022 12:28:47
Flo
Funktioniert nicht er zeigt mir Laufzeitfehler an und vorher waren ja 5 von den 30 stellen noch frei die zeigt er jetzt auch bei rechtsklick an mit einem =:
Userbild
Nun klappt der OnAction Effekt auch nicht mehr.
VG
Flo
Anzeige
lad die Datei hoch. owT
24.02.2022 13:48:15
Rudi
AW: lad die Datei hoch. owT
24.02.2022 15:25:39
Rudi
Hallo,
Beschriftungen werden direkt aus Blatt Grundeinstellungen geholt.
Durch die Änderung der Caption kommt es logischerweise zu Fehlern in Färbe().

Option Explicit                                     ' Variablendefinition erforderlich
Option Private Module
Public Const CONTEXT_MENU = "MyCommandBar"
Public Sub CreateCommandBar()
Dim objCommandBar As CommandBar
Dim objCommandBarButton As CommandBarButton
Dim lngIndex As Long, lngCOLOR As Long
Dim strNameKk As String, strNameK As String
On Error Resume Next
CommandBars(CONTEXT_MENU).Delete
On Error GoTo 0
Set objCommandBar = CommandBars.Add _
(Name:=CONTEXT_MENU, Position:=msoBarPopup, Temporary:=True)
With Sheets("Grundeinstellungen")
For lngIndex = 17 To .Cells(Rows.Count, 3).End(xlUp).Row
strNameKk = Trim(.Cells(lngIndex, 3))
strNameK = Trim(.Cells(lngIndex, 4))
lngCOLOR = .Cells(lngIndex, 3).Interior.Color
Set objCommandBarButton = objCommandBar.Controls.Add(Type:=msoControlButton)
With objCommandBarButton
.Caption = strNameKk & "=" & strNameK
.Tag = lngCOLOR
.OnAction = "Färbe"
End With
Next
End With
Set objCommandBarButton = Nothing
Set objCommandBar = Nothing
End Sub
Sub Färbe()
Dim rng As Excel.Range
Dim vntInput As Variant
Dim vntTMP
Dim lngCOLOR As Long
Call ActiveSheet.Unprotect(Password:="KdoSAN")
With CommandBars.ActionControl
vntTMP = Split(.Caption, "=")
lngCOLOR = .Tag
End With
Select Case vntTMP(1)
Case Is = "Eintrag löschen"
With Selection
.Interior.PatternColorIndex = xlNone
.Value = vbNullString
If Not ActiveCell.Comment Is Nothing Then ActiveCell.Comment.Delete
End With
Case Is = "Bemerkung"
Do
vntInput = InputBox(Prompt:="Bitte etwas eingeben.", Title:="Eingabe")
If StrPtr(vntInput) = 0 Then Exit Sub 'Abbrechen gedrückt
If Trim$(vntInput) = "" Then
Call MsgBox(Prompt:="Bitte etwas eingeben.", Buttons:=vbExclamation)
Else
Exit Do
End If
Loop
For Each rng In Selection
With rng
If Not .Comment Is Nothing Then Call .Comment.Delete
Call .AddComment(Text:=vntInput)
.Interior.Color = lngCOLOR
End With
Next
Case Else
For Each rng In Selection
With rng
.Interior.Color = lngCOLOR
.Value = vntTMP(0)
End With
Next
End Select
Call ActiveSheet.Protect(Password:="KdoSAN", userinterfaceonly:=True, AllowFiltering:=True)
End Sub
Gruß
Rudi
Anzeige
AW: lad die Datei hoch. owT
24.02.2022 16:07:07
Flo
Danke es funktioniert , habe nur noch ein Problem.
Er gibt mir folgende Fehlermeldung aus:
Userbild
VG
Flo
das kann ich ...
24.02.2022 16:53:00
Rudi
1. nicht lesen
und dir
2. wahrscheinlich nicht helfen
Gruß
Rudi
AW: lad die Datei hoch. owT
02.03.2022 21:06:44
Mullit
Hallo,
Du brauchst nur in der CreateCommandBar-Proc das hier ändern...und mal allgemein das Kontextmenü dürfte von Nepumuk sein, die Kiste rennt nat., der Rest aber ist Programmierung des Satans, um meinen alten Mathe Lehrer mal zu zitieren...

With objCommandBarButton
.Caption = Range(objName.Name).Offset(0, -1).Value & " = " & Range(objName.Name).Value
Du darfst nicht jede Wald und Wiesen-Laufvariable auf Verdacht Public deklarieren, weil da oben im Modulkopf soviel Platz und frische Luft bei guter Aussicht is...;-)
https://www.herber.de/bbs/user/151516.zip
Gruß, Mullit
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige