Kontextmenü weiße Felder

SmileStyle · 2021-07-06T08:00:42+00:00

Guten Morgen, ich habe mir ein Kontextmenü gebaut mit 25 Einträgen davon sind die letzten 4 leer. Wenn ich jetzt rechtsklicke tauchen die leeren Platzhalter auf bekomme ich diese irgendwie weg ? Mein Code lautet wie folgt : Sub KontextmenueErgaenzen() Dim oBtn As CommandBarButton Dim InI As Integer For InI = Application.CommandBars("Cell").Controls.Count To 1 Step -1 Application.CommandBars("Cell").Controls(1).Delete Next InI For InI = 1 To 25 Set oBtn = Application.CommandBars("Cell").Controls.Add With oBtn .Caption = Range("AbwK" & InI).Value .OnAction = "'Färbe ""AbwK" & InI & """'" End With Next End Sub MfG SmileStyle

Hallo,
in das Modul der Tabelle "Grundeinstellungen":


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C43:C46")) Then Call CreateCommandBar
End Sub

Im Modul "kontextmenue":


Public Sub CreateCommandBar()
Dim objCommandBar As CommandBar
Dim objCommandBarButton As CommandBarButton
Dim lngIndex As Long
Call DeleteCommandBar
Set objCommandBar = CommandBars.Add(Name:=CONTEXT_MENU, _
Position:=msoBarPopup, Temporary:=True)
For lngIndex = 1 To 25
If Not IsEmpty(Range("AbwK" & CStr(lngIndex)).Value) Then
Set objCommandBarButton = objCommandBar.Controls.Add(Type:=msoControlButton)
With objCommandBarButton
.Caption = Range("AbwK" & CStr(lngIndex)).Value
.OnAction = "'Färbe ""AbwK" & CStr(lngIndex) & """'"
End With
End If
Next
Set objCommandBarButton = Nothing
Set objCommandBar = Nothing
End Sub

Im Modul "DieseArbeitsmappe":


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
Call TimeStop
End If
End Sub

Gruß
Nepumuk

Hallo,
im Modul "kontextmenue":

Code:


[Cc][+][-]

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 """ & objName.Name & """'"

               End With
            End If
         End If
      End If
  Next

  Set objCommandBarButton = Nothing
  Set objCommandBar = Nothing
  Set objName = Nothing

End Sub

Und das Change-Event im Modul der Tabelle "Grundeinstellungen":

Code:


[Cc]

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("C22:C46")) Is Nothing Then Call CreateCommandBar
End Sub

Gruß
Nepumuk

Forumthread: Kontextmenü weiße Felder

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Kontextmenü weiße Felder

Forumthread: Kontextmenü weiße Felder

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread