My created menu looses the icon on QAT

  • Thread starter Thread starter cha Denmark
  • Start date Start date
C

cha Denmark

Hi
I've used Ron de Bruin fantastic menu creator for a long time, but suddenly
the icon, that I have added the QAT have disappeared. I can add it again
manually, run the WBDisplayPopUp and everything works again. But when I close
and start my workbook again my icon is gone. I have added it for this
workbook only.
I cannot figure out what has changed. Any suggestions?
Best regards
cha Denmark
 
Hi Cha

There are more people that have this problem of losing
icons in the QAT on this moment

Can you please send me your workbook private
so i can look at it
 
Hi Ron
Is this what you need?

Option Explicit
Option Private Module
Sub WBCreatePopUp() 'den makro, der kobler menu med grøn pil
' NOTE: There is no error handling in this subroutine

Dim MenuSheet As Worksheet
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton
Dim Row As Integer
Dim MenuLevel, NextLevel, MacroName, Caption, Divider, FaceId

''''''''''''''''''''''''''''''''''''''''''''''''''''
' Location for menu data
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
''''''''''''''''''''''''''''''''''''''''''''''''''''

' Make sure the menus aren't duplicated
Call WBRemovePopUp

' Initialize the row counter
Row = 5

' Add the menu, menu items and submenu items using
' data stored on MenuSheet

' First we create a PopUp menu with the name of the value in B2
With Application.CommandBars.Add(ThisWorkbook.Sheets("MenuSheet"). _
Range("B2").Value, msoBarPopup, False,
True)

Do Until IsEmpty(MenuSheet.Cells(Row, 1))
With MenuSheet
MenuLevel = .Cells(Row, 1)
Caption = .Cells(Row, 2)
MacroName = .Cells(Row, 3)
Divider = .Cells(Row, 4)
FaceId = .Cells(Row, 5)
NextLevel = .Cells(Row + 1, 1)
End With

Select Case MenuLevel
Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem = .Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem = .Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
End If
MenuItem.Caption = Caption
If FaceId <> "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True

Case 3 ' A SubMenu Item
Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = ThisWorkbook.Name & "!" & MacroName
If FaceId <> "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
End With
End Sub


Sub WBRemovePopUp() 'fjerner forbindelsen mellem den grønne pil og menuen.
Pilen er der, men menuen er væk
On Error Resume Next

Application.CommandBars(ThisWorkbook.Sheets("MenuSheet").Range("B2").Value).Delete
On Error GoTo 0
End Sub
Thanks for your help
cha Denmark
 
Back
Top