submenu in excel, vraag2: Fout 13 in vba

Status
Niet open voor verdere reacties.

corvdh

Gebruiker
Lid geworden
29 aug 2010
Berichten
128
Vraag 1-2

Ik heb met de volgende vba code een item toegevoegd aan het rechtsklikmenu in excel:

Code:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
        Cancel As Boolean)
    For Each icbc In Application.CommandBars("cell").Controls
        If icbc.Tag = "brccm" Then icbc.Delete
    Next icbc
    If Not Application.Intersect(Target, Range("a1:L17")) _
            Is Nothing Then
        With Application.CommandBars("cell").Controls _
            .Add(Type:=msoControlButton, before:=1, _
                temporary:=True)
           .Caption = "Test1"
           .OnAction = "Test_macro"
           .Tag = "brccm"
        End With
End Sub

Nu staat het item bovenaan het rechtermuisklikmenu, maar ik zou dit graag in een submenu willen hebben.
Hoe pas ik deze code aan om een submenu te krijgen?

Vraag 2-2

Ik heb op het internet een stukje vba code gevonden die een melding laat verschijnen en hem na een zelf te kiezen aantal seconden weer laat verdwijnen.

Code:
Private Sub CommandButton1_Click()
CreateObject("WScript.Shell").Popup "Melding verdwijnt na 3 sec. uit beeld ", 3, "Test melding"
End sub

Dit werkt goed maar nu wil ik daar een uitroepteken icoon bij hebben dus heb ik de code aangepast naar:

Code:
Private Sub CommandButton1_Click()
CreateObject("WScript.Shell").Popup "Melding verdwijnt na 3 sec. uit beeld ", 3, vbExclamation, "Test melding"
End sub

Ik krijg dan de volgende melding:
Fout 13 tijdens uitvoering
Typen komen niet met elkaar overeen.

Wat is hier fout?
 
Ik heb geen ervaring met het maken van een pop-up op deze manier, dus dat ga ik zo nog wel uitproberen, maar dat je een foutmelding krijgt is wel verklaarbaar. Als je de twee regels onder elkaar zet, zie je het hopelijk ook:
CreateObject("WScript.Shell").Popup "Melding verdwijnt na 3 sec. uit beeld ", 3, "Test
CreateObject("WScript.Shell").Popup "Melding verdwijnt na 3 sec. uit beeld ", 3, vbExclamation, "Test

In de eerste code staan alle paramaters achter elkaar. Deze code werkt.
In de tweede code heb je er een parameter tussen gevoegd (vbExclamation). En dat terwijl de volgorde van de parameters bij een functie altijd vastligt... Je bent echter de volgorde van de parameters aan het veranderen. Als je al een type kunt kiezen, zou het er dan misschien zo uit moeten zien:
CreateObject("WScript.Shell").Popup "Melding verdwijnt na 3 sec. uit beeld ", 3, "Test, vbExclamation
 
Hallo,

Ik heb de code aangepast naar:
Code:
CreateObject("WScript.Shell").Popup "Melding verdwijnt na 3 sec. uit beeld", 3, "Test melding", vbExclamation
Een melding met uitroepteken icoon verschijnt voor 3 seconden, precies wat ik zocht.

Nu alleen nog een antwoord op vraag 1.
 
corvdh,

Ik heb hier een file dat over menu maken gaat.
Het is gemaakt door Jim Rech en nog bewerkt door SNB.
 

Bijlagen

Leuke file, maar nu heb ik nog steeds geen submenu in het rechtsklikmenu.
 
corvdh

Kijk op deze link bijna onderaan.
Daar gaat het over Snelmenu en Submenu.
Ik zie wel als het gelukt is wat de code geworden is.
 
Ik heb inmiddels een oplossing gevonden.

Code:
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

    Dim ctrl As CommandBarControl
    Dim btn As CommandBarControl
    
    ' Reset het contextmenu naar standaard waarden
    For Each icbc In Application.CommandBars("cell").Controls
        If icbc.Tag = "brccm" Then
            icbc.Delete
        Else
            icbc.Visible = True
            icbc.Enabled = True
        End If
    Next icbc
        
            ' Eerst alle standaard menu items verstoppen
            For Each ctrl In Application.CommandBars("Cell").Controls
                ctrl.Visible = False
            Next
            
            
            ' Voeg submenu 1 toe
            Set ctrl = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup)
            ctrl.Caption = "Meer macro's..."
            Set btn = ctrl.Controls.Add(Type:=msoControlButton)
            btn.Caption = "knoptekst1"
            btn.Tag = "tag"
            btn.OnAction = "Macro1"
            btn.FaceId = 59
            
            Set btn = ctrl.Controls.Add(Type:=msoControlButton)
            btn.Caption = "Knoptekst2"
            btn.Tag = "tag"
            btn.OnAction = "Macro2"
            btn.FaceId = 59
Deze code heb ik inmiddels uitgebreid en aangepast naar mijn eigen wensen en werkt perfect.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan