Option Explicit
Public Sub Auto_Open()
CreateMenu
End Sub
Public Sub Auto_Close()
DeleteBar
End Sub
Sub removeaddin()
Application.CommandBars(1).Reset
ThisWorkbook.IsAddin = True
End Sub
Public Sub CreateMenu()
Dim AppCB As Object
Dim wks As Worksheet
Dim Bar As Object
Dim BarBtn As Object
Dim SubBarBtn As Object
Dim buf As Variant
Dim i As Long
Dim KindaMenu As Long
DeleteBar
Set AppCB = Application.CommandBars
Set wks = ThisWorkbook.Sheets("MenuWks")
KindaMenu = wks.[F1]
buf = wks.Range("Menu_Level").Value
Select Case KindaMenu
Case 1 'Worksheet Menu Bar
If buf(1, 3) = "" Then
Set Bar = AppCB(1).Controls.Add(msoControlPopup)
Else
Set Bar = AppCB(1).Controls.Add(msoControlPopup, Before:=buf(1, 3))
End If
Case 2
If buf(1, 3) = "" Then
Set Bar = AppCB("cell").Controls.Add(msoControlPopup)
Else
Set Bar = AppCB("cell").Controls.Add(msoControlPopup, Before:=buf(1, 3))
End If
End Select
With Bar
If Not KindaMenu = 3 Then
.BeginGroup = buf(1, 4)
.Caption = buf(1, 2 + ICS)
.Tag = RemoveAmp(buf(1, 2 + ICS))
End If
For i = LBound(buf) To UBound(buf)
Select Case buf(i, 1)
Case 2
On Error Resume Next
If buf(i + 1, 1) = 3 Then
If Err.Number = 0 Then
Set BarBtn = .Controls.Add(msoControlPopup)
Else
Set BarBtn = .Controls.Add(msoControlButton)
End If
Else
Set BarBtn = .Controls.Add(msoControlButton)
End If
With BarBtn
.Caption = buf(i, 2 + ICS)
.OnAction = buf(i, 3)
.BeginGroup = buf(i, 4)
If buf(i, 5) <> "" Then .FaceId = buf(i, 5)
End With
On Error GoTo 0
Case 3
Set SubBarBtn = BarBtn.Controls.Add(msoControlButton)
With SubBarBtn
.Caption = buf(i, 2 + ICS)
.OnAction = buf(i, 3)
.BeginGroup = buf(i, 4)
.FaceId = buf(i, 5)
End With
End Select
Next
.Visible = True
End With
End Sub
Public Function RemoveAmp(seq) As String
Dim i As Long
Dim tmp As String
For i = 1 To Len(seq)
If Mid(seq, i, 1) <> "&" Then
tmp = tmp & Mid(seq, i, 1)
End If
Next
RemoveAmp = tmp
End Function
Public Sub DeleteBar()
Dim buf As Variant
buf = ThisWorkbook.Sheets("MenuWks").Range("Menu_Level").Value
On Error Resume Next
Application.CommandBars.FindControl(Tag:=RemoveAmp(buf(1, 2 + ICS))).Delete
'For a Commndbar Control
Application.CommandBars(RemoveAmp(buf(1, 2 + ICS))).Delete
On Error GoTo 0
End Sub
Private Function ICS() As Integer
Dim tmpICS As Integer
tmpICS = Application.International(xlCountrySetting)
If tmpICS = 47 Then
ICS = 6
Else
ICS = 0
End If
End Function