Menu's samenvoegen via VBA add-in

  • Onderwerp starter Onderwerp starter dpey
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
D

dpey

Gebruiker
Lid geworden
23 jun 2007
Berichten
15
Goedemiddag,

Ik heb verschillende excel betanden met macro's. Bij het openen van deze bestanden wordt er onder de tab "Invoegtoepassingen" een menu geplaatst via de volgende macro:

Code: 
Private Sub Workbook_Open()

    Dim cmbBar As CommandBar
    Dim cmbControl As CommandBarControl
     
    Set cmbBar = Application.CommandBars("Worksheet Menu Bar")
    Set cmbControl = cmbBar.Controls.Add(Type:=msoControlPopup, temporary:=True) 'adds a menu item to the Menu Bar
    With cmbControl
        .Caption = "&Menu" 'names the menu item
        With .Controls.Add(Type:=msoControlButton) 'adds a dropdown button to the menu item
            .Caption = "Macro 2" 'adds a description to the menu item
            .OnAction = "module1.form" 'runs the specified macro
            .FaceId = 4385 'assigns an icon to the dropdown
        End With
        
        With .Controls.Add(Type:=msoControlButton) 'adds a dropdown button to the menu item
            .Caption = "Werkblad leegmaken" 'adds a description to the menu item
            .OnAction = "module1.ClearWorkmap" 'runs the specified macro
            .FaceId = 1019 'assigns an icon to the dropdown
        End With
     End With
    
 End Sub

Omdat ik niet steeds een ander bestand wil openen heb ik de bestanden opgeslagen als XLAM en geplaatst in %userprofile%\AppData\Roaming\Microsoft\AddIns zodat deze geladen worden als ik Excel opstart.

Het probleem is echter dat hij de menu's niet samenvoegd, maar dubbel laat zien. In het bijgevoegd voorbeeld wordt er 2x het menu "Menu" aangemaakt.
1.png

Wat ik wil bereiken is dat er 1 menu wordt aangemaakt, zoals op de volgende afbeelding:
2.png

Is dit mogelijk?

(zie ook de bijlage voor de XLAM bestanden. De bestanden heb ik hernoemd naar xls omdat ik deze anders niet kon uploaden, dus zelf even hernoemen naar .xlam)

Alvast bedankt!
 

Bijlagen

Als in een een macro .controls.add staat wordt een nieuw element aangemaakt. Samenvoegen -wat je daarmee ook moge bedoelen - realiseer je natuurlijk niet met add.
De code doet precies waar de term voor staat.
 
Duidelijk, maar kan ik de code aanpassen zodat, als het menu al bestaat (dezelfde naam), de actie wordt overgeslagen?

Nu maakt hij 2x een menu aan met de tekst "Menu". Met Samenvoegen bedoel ik dat hij zowel macro 1 als macro 2 onder een menu plaatst (via 2 verschillende addins). Zie ook de screenshots in de eerste post.
 
Je kan hem eerst verwijderen voordat je hem toevoegd:
Application.CommandBars("Worksheet Menu Bar").Controls("Macro 2").DELETE
 
Dit zal niet gaan werken voor mij.

Ik wil dat zowel macro 1 als macro 2 getoond worden (onder 1 menu) als men beide add-ins heeft.

Het zal echter ook nog moeten werken als er maar 1 add-in actief is.
 
Dan hoef je toch altijd maar 1 addin te laden.
Daar laat je het dan bij. Het heeft geen zin een tweede addin te laden met dezelfde functionaliteit.
 
Dag dpey !

Je zou de popup een Tag kunnen geven en dan slechts de popup opladen als die nog niet bestaat.

Code: 
Private Sub Workbook_Open()

    Dim cmbBar As CommandBar
    Dim cmbControl As CommandBarControl

  [COLOR="#FF0000"]  If controlExist() Then Exit Sub[/COLOR]

    Set cmbBar = Application.CommandBars("Worksheet Menu Bar")
    Set cmbControl = cmbBar.Controls.Add(Type:=msoControlPopup, temporary:=True) 'adds a menu item to the Menu Bar
    With cmbControl
        .Caption = "&Menu" 'names the menu item
        [COLOR="#FF0000"].Tag = "myPopup"[/COLOR]
        
        With .Controls.Add(Type:=msoControlButton) 'adds a dropdown button to the menu item
            .Caption = "Macro 2" 'adds a description to the menu item
            .OnAction = "module1.form" 'runs the specified macro
            .FaceId = 4385 'assigns an icon to the dropdown
        End With
        
        With .Controls.Add(Type:=msoControlButton) 'adds a dropdown button to the menu item
            .Caption = "Werkblad leegmaken" 'adds a description to the menu item
            .OnAction = "module1.ClearWorkmap" 'runs the specified macro
            .FaceId = 1019 'assigns an icon to the dropdown
        End With
     End With
    
 End Sub



[COLOR="#FF0000"]Function controlExist() As Boolean
Dim oControl As CommandBarControl
For Each oControl In Application.CommandBars("Worksheet Menu Bar").Controls
    If oControl.Tag = "myPopup" Then
        controlExist = True
        Exit Function
    End If
Next
End Function[/COLOR]

Grtz,
MDN111.
 
"Macro 2" is in mijn voorbeeld uiteraard arbitrair. Daar gebruik je wat nodig is.

Je kan ook doen wat MDN111 zegt.
 
Laatst bewerkt:
Dankjewel, deze doet nog niet helemaal wat ik wil, maar kan er misschien wel verder mee.


In het voorbeeld van MDN111 wordt de sub beëindigd als het menu met de tekst "Menu" bestaat. Er wordt dus geen 2e menu met dezelfde tekst aangemaakt. Dit klopt.
Hij moet echter wel nog de submenu's maken. Dat doe hij in dit voorbeeld niet.

@SNB: Ik gebruik meerdere add-ins omdat elke add-in een andere macro aanroept. Niet elke gebruiker hoeft alle add-ins te gebruiken.
 
Handig.¿¿
Dat kun je toch ook regelen met de environ("username").
 
dpey zei:
In het voorbeeld van MDN111 wordt de sub beëindigd als het menu met de tekst "Menu" bestaat. Er wordt dus geen 2e menu met dezelfde tekst aangemaakt. Dit klopt. Hij moet echter wel nog de submenu's maken. Dat doe hij in dit voorbeeld niet.
Klik om te vergroten...

Voorbeelden zijn waarom ze voorbeelden heten. Het is toch niet zo moeilijk om het voorbeeld van MDN111 aan te passen aan wat je zelf wilt?
 
edmoor zei:
Voorbeelden zijn waarom ze voorbeelden heten. Het is toch niet zo moeilijk om het voorbeeld van MDN111 aan te passen aan wat je zelf wilt?
Klik om te vergroten...

Voor iemand met niet zoveel VBA ervaring is dit wel vrij moeilijk. :rolleyes:
Ik ga hier in ieder geval verder mee stoeien, maar als jullie tips hebben, dan houd ik mij aanbevolen.
 
Het lijkt erop dat ik eruit ben, wellicht dat het wel "mooier" kan, maar ik ben tevreden.

Via onderstaande code wordt het hoofdmenu aangemaakt indien het nog niet bestaat. Indien het al bestaat wordt er géén 2e gecreëerd.
Het sub menu is bij elke Add-in verschillend. Wel heeft elk submenu de button "werkblad leegmaken" erbij staan, dus deze hoeft maar 1 x gecreëerd te worden. Onderstaande code is van addin: "Macro 1".

Code: 
Private Sub Workbook_Open()

Call hoofdmenu
Call submenu1
Call submenu2

End Sub


Sub hoofdmenu()

    Dim cmbBar As CommandBar
    Dim cmbControl As CommandBarControl
    
If controlExist() Then Exit Sub
     
    Set cmbBar = Application.CommandBars("Worksheet Menu Bar")
    Set cmbControl = cmbBar.Controls.Add(Type:=msoControlPopup, temporary:=True) 'adds a menu item to the Menu Bar
    
        
    With cmbControl
        .Caption = "&Menu" 'names the menu item
        .Tag = "hoofdmenu"
End With
End Sub


Sub submenu1()

On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&Menu").Controls("Macro1").delete

With Application.CommandBars("Worksheet Menu Bar").Controls("&Menu")

        With .Controls.Add(Type:=msoControlButton) 'adds a dropdown button to the menu item
            .Caption = "Macro1" 'adds a description to the menu item
            .OnAction = "module1.form" 'runs the specified macro
            .FaceId = 4385 'assigns an icon to the dropdown
          End With
        
     
     End With
End Sub


Sub submenu2()

On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&Menu").Controls("Werkblad leegmaken").delete

With Application.CommandBars("Worksheet Menu Bar").Controls("&Menu")


        With .Controls.Add(Type:=msoControlButton) 'adds a dropdown button to the menu item
            .Caption = "Werkblad leegmaken" 'adds a description to the menu item
            .OnAction = "module1.ClearWorkmap"" 'runs the specified macro"
            .FaceId = 1019 'assigns an icon to the dropdown
        End With
        
     
     End With
End Sub
 


Function controlExist() As Boolean
Dim oControl As CommandBarControl
For Each oControl In Application.CommandBars("Worksheet Menu Bar").Controls
    If oControl.Tag = "hoofdmenu" Then
        controlExist = True
        Exit Function
    End If
Next
End Function


Bedankt voor jullie hulp! :thumb:
 
Code: 
Sub hoofdmenu()
    On Error Resume Next
    
    With Application.CommandBars(1)
        x3 = .Controls("&Menu").Tag
        
        If Err.Number <> 0 Then
           With .Controls.Add(10, , , , True)
            .Caption = "&Menu"
            .Tag = "hoofdmenu"
            End With
        End If
    End With
End Sub
 
snb zei:
Code: 
Sub hoofdmenu()
    On Error Resume Next
    
    With Application.CommandBars(1)
        x3 = .Controls("&Menu").Tag
        
        If Err.Number <> 0 Then
           With .Controls.Add(10, , , , True)
            .Caption = "&Menu"
            .Tag = "hoofdmenu"
            End With
        End If
    End With
End Sub
Klik om te vergroten...

thx! :thumb:
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan