Context menu makroyu nasil yeni workbook'la birlestirebilirim?

[vaybeeee]

Merhaba Excel.web.tr Forumu,

Bulunan dosyadaki eski koda yeni kodu eklemek istiyorum.
Bu yeni kod sag fare tusu (context menu) icindir.
Bunu nasil yapabilirim?
Malesef VBA'dan fazla anlamiyorum.
Kullandigim Version: Excel 2003; Ingilizce.
Önerileriniz icin simdiden tesekkürler ederim.
Cözümünüzü Excel Dosyasi olarak Foruma ekleyebilirseniz, buna cok sevinirim.

Saygilarimla iyi günler diliyorum.


Workbook'daki Kodlar:

Option Explicit

' Navigationsmenü Tabellen
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  On Error Resume Next
  Application.CommandBars("Tabellen").Delete
  MenüLöschen
  On Error GoTo 0
End Sub
' Ende Navigationsmenü Tabellen

Private Sub Workbook_Open()
Dim Tabelle As Worksheet

 Sheets("LISTE").Select
' ActiveSheet.ListBox1.Clear
 For Each Tabelle In ThisWorkbook.Worksheets
'  If Tabelle.Visible = True Then ActiveSheet.ListBox1.AddItem Tabelle.Name
 Next Tabelle
 NeuesMenüEinfügen
  Call Menü_einfügen
    On Error Resume Next
    Load UserForm1
End Sub

Public Sub Beenden()
    Unload UserForm1
End Sub


' Kontextmenü für Tabellenverzeichnis


Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim cCont As CommandBarButton
    On Error Resume Next
    Application.CommandBars("Cell").Controls("Tabellenverzeichnis").Delete
    On Error GoTo 0
        Set cCont = Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, Temporary:=True)
        cCont.Caption = "Tabellenverzeichnis"
        cCont.OnAction = "IndexCode"
End Sub

' Ende Kontextmenü für Tabellenverzeichnis

Yeni Module:

Option Explicit                             ' Variablendefinition erforderlich
'**************************************************
'* H. Ziplies                                     *
'* 17.08.2003                                     *
'* erstellt von HajoZiplies@web.de                *
'* http://Hajo-Excel.de/                          *
'**************************************************
Sub KontextmenueErgaenzen()
    ' Konrextmenü ansprechen
    With CommandBars("Cell").Controls.Add(Type:=msoControlPopup)
        .BeginGroup = True              'Trennlinie
        ' Fehlerbehandlung ausschalten
        'On Error GoTo 0
        .Caption = "Hajo &Ziplies"          ' Beschriftung Hauptpunkt
        ' erster Menüpunkt
        With .Controls.Add                  ' Untermenü erzeugen
            .FaceId = 330                   ' Icon 1. Untermenü
            .Caption = "&Ausblenden"        ' Beschriftung 1. Untermenü
            .OnAction = "Ausblenden"        ' Makro 1. untermenü
        End With
        ' Zweiter Menüpunkt
        With .Controls.Add                  ' Untermenü erzeugen
            .FaceId = 2105
            .Caption = "&Einblenden"
            .OnAction = "Einblenden"
        End With
        '*********************************************************
        ' Untermenü erzeugen:
        ' dritter Menüpunkt mit Untermenü
        With .Controls.Add(Type:=msoControlPopup)
            .BeginGroup = True 'Trennlinie
            .Caption = "&Hajo Spezial :--)"
            With .Controls.Add
                .FaceId = 330
                .Caption = "&Untermenü1"
                .OnAction = "Untermenue1"
            End With
            With .Controls.Add
                .FaceId = 2105
                .Caption = "&Untermenü2"
                .OnAction = "Untermenue2"
            End With
        End With
        '*********************************************
        ' wieder normal weiter:
        ' vierter menüpunkt
        With .Controls.Add
            .FaceId = 330
            .Caption = "&Hoch"
            .OnAction = "Hoch"
        End With
        ' Fehlerbehandlung einschalten
        'On Error GoTo 0
    End With
End Sub

Sub KontextmenueZuruecksetzen()
    ' Fehlerbehandlung ausscahlten
    On Error Resume Next
    Application.CommandBars("Cell").Controls("Hajo &Ziplies").Delete
    ' Fehlerbehandlung einschalten
    On Error GoTo 0
End Sub

Sub Einblenden()
    MsgBox "Einblenden"
End Sub

Sub Ausblenden()
    MsgBox "Ausblenden"
End Sub

Sub Hoch()
    MsgBox "Hoch"
End Sub

Sub untermenue1()
    MsgBox "Untermenüe1"
End Sub

Sub untermenue2()
    MsgBox "Untermenüe2"
End Sub

Yeni Workbook'daki Kodlar:

Option Explicit                             ' Variablendefinition erforderlich
'**************************************************
'* H. Ziplies                                     *
'* 17.08.2003                                     *
'* erstellt von Hajo.Ziplies@web.de               *
'* http://Hajo-Excel.de/                          *
'**************************************************
Dim BoMenue As Boolean

Private Sub Workbook_Activate()
    If BoMenue = False Then KontextmenueErgaenzen
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    KontextmenueZuruecksetzen
End Sub

Private Sub Workbook_Deactivate()
    BoMenue = False
    KontextmenueZuruecksetzen
End Sub

Private Sub Workbook_Open()
    KontextmenueErgaenzen
    BoMenue = True
End Sub

 

[vaybeeee]

Aceba sorunumu anlatamadimmi :?: