VBA Kontextmenü showpopup Laufzeitfehler??
04.01.2004 19:28:38
goma
Vielleicht vorab ich hab xl97
Aber es klappte mal dann immer nur wenn ich xl komplett schloß und jetzt nachdem ich für meine commandbar mycontext2 die onaction subs fertig habe (umständlich aber die klappen manchmal) funktioniert mycontext nicht mehr. Hab jetzt ja zwei eigene Kontextmenüs + commandbars(cell) meine eigenen jeweils nur bei bestimmten Zellen.
Hat alles wie gesagt mal funktioniert bis ich den commandbarbuttons von mycontext2 die onaction subs zugepackt hab (hier auf ein Bsp. Red)
Schalte ich irgendwas ein und dann nicht wieder ab raff eigendlich fast nichts mehr?????
Was mach ich wieder falsch?????
Würde mich freuen wenn Ihr euch meiner doch noch mal annehmen könntet.
Fehlermeldung: Laufzeitfehler 5
Unzulässiger Prozeduraufruf oder ungültiges Argument
Wenn ich auf test gehe wird -
Application.CommandBars("mycontext").ShowPopup - gelb markiert
Gruß Goma
Nachfolgen hab ich mal den Code aufgeführt
Inthisworkbook:
Private Sub Workbook_Activate()
Dim cBars As CommandBars
Set cBars = Application.CommandBars
Call CustomContext_Add(cBars.FindControl(1, , "ContextButton1"))
Call CustomContext2_Add(cBars.FindControl(2, , "ContextButton2"))
End Sub
Private Sub Workbook_Deactivate()
Dim cBars As CommandBars
Set cBars = Application.CommandBars
Call CustomContext_Del(cBars.FindControl(1, , "ContextButton1"))
Call CustomContext2_Del(cBars.FindControl(2, , "ContextButton2"))
End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim cmdB As CommandBarButton
Set cmdB = Application.CommandBars.FindControl(1, , "ContextButton1")
If cmdB Is Nothing Then Exit Sub
Select Case Sh.Index
Case 1
If Target.Address = "$B$26" Then
Application.CommandBars("mycontext").ShowPopup
Cancel = True
End If
If Target.Address = "$B$27" Then
Application.CommandBars("mycontext").ShowPopup
Cancel = True
End If
If Target.Address = "$B$28" Then
Application.CommandBars("mycontext").ShowPopup
Cancel = True
End If
If Target.Address = "$B$29" Then
Application.CommandBars("mycontext").ShowPopup
Cancel = True
End If
If Target.Address = "$B$30" Then
Application.CommandBars("mycontext").ShowPopup
Cancel = True
End If
If Target.Address = "$B$31" Then
Application.CommandBars("mycontext").ShowPopup
Cancel = True
End If
If Target.Address = "$B$15" Then
Application.CommandBars("mycontext2").ShowPopup
Cancel = True
End If
If Target.Address = "$B$16" Then
Application.CommandBars("mycontext2").ShowPopup
Cancel = True
End If
If Target.Address = "$B$17" Then
Application.CommandBars("mycontext2").ShowPopup
Cancel = True
End If
End Select
End Sub
'in modul:
'lieferanten als string für kontektmenü und dem onaction
Dim lieferant1$
Dim zieladresse1$
Sub CustomContext_Add(cmdB As CommandBarButton)
Dim KonBef As CommandBarControl
Dim KonBef2 As CommandBarControl
Dim KonBef3 As CommandBarControl
Dim drehen1 As String
Dim cmdP As CommandBarPopup 'custom contextmenu
Application.ScreenUpdating = False
If cmdB Is Nothing Then
With Application.CommandBars.Add("myContext", msoBarPopup, , True)
'1stufe
Set KonBef = .Controls.Add(Type:=msoControlPopup, temporary:=True)
KonBef.Caption = "Drehen"
'2stufe
Set KonBef2 = KonBef.Controls.Add(Type:=msoControlPopup, temporary:=True)
KonBef2.Caption = "CNC Drehen"
Worksheets("Maschinenliste").Activate
Range("C2").Activate
drehen1 = ActiveCell.Value
'3stufe
Set KonBef3 = KonBef2.Controls.Add
With KonBef3
.Caption = drehen1
.FaceId = 0
.OnAction = "drehen1"
.Tag = "ContextButton1"
End With
End With
End If
Worksheets("Kalkulation").Activate
Application.ScreenUpdating = True
End Sub
Sub CustomContext_Del(cmdB As CommandBarButton)
Application.CommandBars("myContext").Delete
End Sub
Sub CustomContext2_Add(cmdB As CommandBarButton)
Dim cmdP As CommandBarPopup 'custom contextmenu2
Application.ScreenUpdating = False
Worksheets("Lieferantenliste").Activate
Range("A4").Activate
lieferant1 = ActiveCell.Value
If cmdB Is Nothing Then
With Application.CommandBars.Add("myContext2", msoBarPopup, , True)
With .Controls.Add(msoControlButton, , , , True)
.BeginGroup = False
.Caption = lieferant1
.OnAction = "blieferant1"
.Style = msoButtonIconAndCaption
.Tag = "ContextButton2"
End With
End With
End If
Worksheets("Kalkulation").Activate
Application.ScreenUpdating = True
End Sub
Sub CustomContext2_Del(cmdB As CommandBarButton)
Application.CommandBars("myContext2").Delete
End Sub
Sub blieferant1()
zieladresse1 = ActiveCell.Address
'Worksheets("Kalkulation").Activate
Range(zieladresse1).Activate
MsgBox (lieferant1)
ActiveCell.Offset(0, 1).Value = lieferant1
End Sub