Zellkontextmenue-erweiterung



Excel-Version: 9.0 (Office 2000)
nach unten

Betrifft: Zellkontextmenue-erweiterung
von: Rainer Quaas
Geschrieben am: 14.05.2002 - 09:41:15

Hallo Excel-User,

im Zellkontextmenue versuche ich neue Menüs, Untermenüs und Controlbuttons zu erstellen. Leider habe ich Probleme in den Untermenüs mehrere Controlbuttons einzufügen. Wäre nett, wenn mir jemand helfen, den Code korrigieren könnte.

Mein Zellkontextmenü sollte folgendermaßen strukturiert sein:

Kontextmenü
1. Untermenü (Makro 1, Makro2, Makro3)
2. Untermenü (…..)
3. Untermenü (…. )

Mein Zellkontextmenü ist aber folgendermaßen strukturiert:

Kontextmenü
1. Untermenü (Makro 1)
Makro 2
Makro 3
2. Untermenü (…..)
3. Untermenü (…. )


Sub Zell_Kontextmenue_Erweiterung()

Dim C_Hauptmenue As CommandBarControl
Dim C_Untermenue_1 As CommandBarControl
Dim C_Untermenue_2 As CommandBarControl
Dim C_Untermenue_3 As CommandBarControl


    With CommandBars("Cell")
        Set C_Hauptmenue = .Controls.Add(Type:=msoControlPopup, before:=1, Temporary:=True)
        C_Hauptmenue.Caption = "Kontext-Menü"
        
        Application.CommandBars("Cell").Controls("Ausschneiden").BeginGroup = True
        
        Set C_Untermenue_1 = C_Hauptmenue.Controls.Add(Type:=msoControlPopup, Temporary:=True)
        C_Untermenue_1.Caption = "1. Untermenü"
        
        Set C_Untermenue_1 = C_Untermenue_1.Controls.Add(Type:=msoControlButton, Temporary:=True)
        With C_Untermenue_1
            .Caption = "Makro 1"
            .OnAction = "Makro_1"
        End With
        
        Set C_Untermenue_1 = C_Hauptmenue.Controls.Add(Type:=msoControlButton, Temporary:=True)
        With C_Untermenue_1
            .Caption = "Makro 2"
            .OnAction = "Makro_2"
        End With
        
        Set C_Untermenue_1 = C_Hauptmenue.Controls.Add(msoControlButton, Temporary:=True)
        With C_Untermenue_1
            .Caption = "Makro 3"
            .OnAction = "Makro_3"
        End With
        
        Set C_Untermenue_2 = C_Hauptmenue.Controls.Add(Type:=msoControlPopup, Temporary:=True)
        With C_Untermenue_2
            .Caption = "2. Untermenü"
        End With
        
        Set C_Untermenue_3 = C_Hauptmenue.Controls.Add(Type:=msoControlPopup, Temporary:=True)
        With C_Untermenue_3
            .Caption = "3. Untermenü"
        End With
        
    End With
End Sub

Gruß Rainer


nach oben   nach unten

Re: Zellkontextmenue-erweiterung
von: ajk
Geschrieben am: 14.05.2002 - 10:39:31

Hallo,

in '97 habe ich mal folgendes "gestrickt". Hatte leider keine Zeit Deinen Code durchzusehen. Guck Dir meinen alten an. vielleicht hilft's Dir:

Sub Menuerweitern()

'AJK
'31.08.2001


dim MB As Object
Dim K13 As Object
Dim k13leiste As Object
Dim Ctrl As CommandBarButton

' While .Controls.Count > 0 'Alle Menüs rechte Maustaste Löschen
' On Error Resume Next
' .Controls(1).Delete
'Wend
Set MB = CommandBars("cell")
Set K13 = MB.Controls.Add(Type:=msoControlPopup, Temporary:=True)
K13.Caption = "K13 - nicht oft genutzt"
K13.BeginGroup = True

With CommandBars("cell")
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Minus"
.OnAction = "minusfalschwert"
.FaceId = 688
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Zellenumrechner"
.OnAction = "rechne"
.FaceId = 50
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "#,##0.00;-#,##0.00"
.OnAction = "dezi"
.FaceId = 398
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "#,##0;-#,##0"
.OnAction = "dezi1"
.FaceId = 397
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "00 00 00"
.OnAction = "dezi2"
.FaceId = 2174
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Seitenformat"
.OnAction = "fuß"
.FaceId = 230
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Werte einfügen"
.OnAction = "Werte"
.FaceId = 582
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Formate einfügen"
.OnAction = "formate"
.FaceId = 108
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Formel einfügen"
.OnAction = "formel"
.FaceId = 879
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Zeilenmarkierung ein"
.OnAction = "MauszeigerEinschalten"
.FaceId = 1664
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Zeilenmarkierung aus"
.OnAction = "Mauszeigerausschalten"
.FaceId = 1019
End With
End With

With CommandBars("column")
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Minus"
.OnAction = "minusfalschwert"
.FaceId = 688
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Zellenumrechner"
.OnAction = "rechne"
.FaceId = 50
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "#,##0.00;-#,##0.00"
.OnAction = "dezi"
.FaceId = 398
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "#,##0;-#,##0"
.OnAction = "dezi1"
.FaceId = 397
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "00 00 00"
.OnAction = "dezi2"
.FaceId = 2174
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Seitenformat"
.OnAction = "fuß"
.FaceId = 230
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Werte einfügen"
.OnAction = "Werte"
.FaceId = 582
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Formate einfügen"
.OnAction = "formate"
.FaceId = 108
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Formel einfügen"
.OnAction = "formel"
.FaceId = 879
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "rot/grün"
.OnAction = "formelr"
.FaceId = 111
End With
End With
With CommandBars("row")
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Minus"
.OnAction = "minusfalschwert"
.FaceId = 688
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Zellenumrechner"
.OnAction = "rechne"
.FaceId = 50
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "#,##0.00;-#,##0.00"
.OnAction = "dezi"
.FaceId = 398
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "#,##0;-#,##0"
.OnAction = "dezi1"
.FaceId = 397
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "00 00 00"
.OnAction = "dezi2"
.FaceId = 2174
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Seitenformat"
.OnAction = "fuß"
.FaceId = 230
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Werte einfügen"
.OnAction = "Werte"
.FaceId = 582
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Formate einfügen"
.OnAction = "formate"
.FaceId = 108
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "Formel einfügen"
.OnAction = "formel"
.FaceId = 879
End With
Set Ctrl = .Controls.Add(msoControlButton)
With Ctrl
.Caption = "rot/grün"
.OnAction = "formelr"
.FaceId = 111
End With
End With
Set k13leiste = K13.Controls.Add(Type:=msoControlButton, Id:=1)
'Set Ctrl = .Controls.Add(msoControlButton)
With k13leiste
.Caption = "DM in EUR"
.OnAction = "euro"
.FaceId = 129
End With
Set k13leiste = K13.Controls.Add(Type:=msoControlButton, Id:=1)
'Set Ctrl = .Controls.Add(msoControlButton)
'With Ctrl
With k13leiste
.Caption = "EUR in DM"
.OnAction = "DM"
.FaceId = 128
End With
Set k13leiste = K13.Controls.Add(Type:=msoControlButton, Id:=1)
'Set Ctrl = .Controls.Add(msoControlButton)
With k13leiste
'With Ctrl
.Caption = "rot/grün"
.OnAction = "formelr"
.FaceId = 111
End With
End Sub
Sub ruecksetzen()
CommandBars("cell").Reset
CommandBars("column").Reset
CommandBars("row").Reset
End Sub

nach oben   nach unten

Re: Zellkontextmenue-erweiterung, hilf nicht weite
von: Rainer Quaas
Geschrieben am: 14.05.2002 - 11:51:11

Hallo ajk,

danke für den langen Code, aber so weit bin ich auch gekommen.

Mein Problem sind die Controls im Untermenü. Bis zu dieser "Tiefe" hast Du nicht programmiert.

Wie gesagt, mein Code funktioniert zwar, nur kann ich die Makros nicht in die Untermenüs setzen.

Gruß Rainer


nach oben   nach unten

Re: DIE Lösung, schaut mal rein
von: Rainer Quaas
Geschrieben am: 14.05.2002 - 16:46:32

Hallo Rainer,

warst ja schon nah' dran, hier die Lösung:


Sub Zell_Kontextmenue_Erweiterung()

Dim C_Hauptmenue As CommandBarControl
Dim C_Untermenue_1 As CommandBarControl
Dim C_Untermenue_2 As CommandBarControl
Dim C_Untermenue_3 As CommandBarControl


    With CommandBars("Cell")
        Set C_Hauptmenue = .Controls.Add(Type:=msoControlPopup, Temporary:=True)
        C_Hauptmenue.Caption = "Kontext-Menü"
        
        Application.CommandBars("Cell").Controls("Ausschneiden").BeginGroup = True
        
 'Untermenü 1
 
        Set C_Untermenue_1 = C_Hauptmenue.Controls.Add(Type:=msoControlPopup, Temporary:=True)
        C_Untermenue_1.Caption = "1. Untermenü"
        

        With C_Untermenue_1
        
            Set C_Untermenue_1 = .Controls.Add(Type:=msoControlButton, Temporary:=True)
            With C_Untermenue_1
                .Caption = "Makro 1"
             .OnAction = "Makro_1"
            End With
        
            Set C_Untermenue_1 = .Controls.Add(Type:=msoControlButton, Temporary:=True)
            With C_Untermenue_1
                .Caption = "Makro 2"
                .OnAction = "Makro_2"
            End With
        
            Set C_Untermenue_1 = .Controls.Add(msoControlButton, Temporary:=True)
            With C_Untermenue_1
                .Caption = "Makro 3"
                .OnAction = "Makro_3"
            End With
            
        End With
        
 'Untermenü 2
        
        Set C_Untermenue_2 = C_Hauptmenue.Controls.Add(Type:=msoControlPopup, Temporary:=True)
        With C_Untermenue_2
            .Caption = "2. Untermenü"
            .BeginGroup = True
        End With
        
        With C_Untermenue_2
        
            Set C_Untermenue_2 = .Controls.Add(Type:=msoControlButton, Temporary:=True)
            With C_Untermenue_2
                .Caption = "Makro 4"
             .OnAction = "Makro_4"
            End With
        
            Set C_Untermenue_2 = .Controls.Add(Type:=msoControlButton, Temporary:=True)
            With C_Untermenue_2
                .Caption = "Makro 5"
                .OnAction = "Makro_5"
            End With
        
            Set C_Untermenue_2 = .Controls.Add(msoControlButton, Temporary:=True)
            With C_Untermenue_2
                .Caption = "Makro 6"
                .OnAction = "Makro_6"
            End With
        
        End With
        
        
 'Untermenü 3
        
        Set C_Untermenue_3 = C_Hauptmenue.Controls.Add(Type:=msoControlPopup, Temporary:=True)
        With C_Untermenue_3
            .Caption = "2. Untermenü"
            .BeginGroup = True
        End With
        
                                
    End With
End Sub

Das Schöne an diesem Makro ist, daß man es leicht an seine eigenen Bedürfnisse anpassen, erweitern oder reduzierrn kann. Sagt mir mal Eure Meinung dazu.

Gruß Rainer


 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Bildschirmschoner im Regedit ausschalten"