Toolbar werkt af en toeniet correct

[AABE]

Geacht Forum,

ik heb een toolbar gemaakt in VBA welke bij het opstarten van de sheet wordt aangemaakt en welke weer verwijderd wordt bij het sluiten van de sheet.

Bij een paar gebruikers komt het voor dat er een button (willekeurig) niet getoond wordt.
Is mijn code correct, of kan ik iets verbeteren waardoor dit probleem zich niet meer voordoet.

Bedankt....

Aat

Sub CifToolBar()
    Dim tBar, newButton
    Dim MacroName As String
    
    'delete CommandBar if it exists
    On Error Resume Next
    CommandBars("CIF ToolBar").Delete
    On Error GoTo 0
    
    'create CommandBar
    CommandBars.Add Name:="CIF ToolBar"
    
    'define an object variable to refer to the CommandBar
    Set tBar = CommandBars("CIF ToolBar")
    
    'add first button
    Set newButton = tBar.Controls.Add(ID:=2950)
    
    'specify tooltip (name), macro to run, and status bar text for the macro
    With newButton
          .Style = msoButtonCaption
          .Caption = "CIF Toolbar"
          .OnAction = "Home"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .Caption = "New Order Change Desk"
          .OnAction = "NewBSRecord"
          .FaceId = 18
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .Caption = "HelpFile"
          .OnAction = "Help"
          .FaceId = 1089
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .Caption = "Move Order from Tracker sheet to Closed Orders sheet"
          .OnAction = "RemoveOrder"
          .FaceId = 1786
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 5827
          .Caption = "Select Customer"
          .OnAction = "SelCust"
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 37
          .Caption = "Refresh Information"
          .OnAction = "Refresh"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 4154
          .Caption = "Unhide Columns & Rows"
          .OnAction = "Unhide"
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
        .FaceId = 988
        .Caption = "Hide Columns where in the first row is a character (e.g. x or 1"
        .OnAction = "HideColumn"
    End With
        
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 989
          .Caption = "Hide Rows with the same information as the selected cell"
          .OnAction = "HideRow"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1105
          .Caption = "Select Rows with the same information as the selected cell"
          .OnAction = "SelectRow"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1774
          .Caption = "Standard Report"
          .OnAction = "LayoutReportStandard"
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1773
          .Caption = "Customized Report"
          .OnAction = "LayoutReportCustomer1"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 279
          .Caption = "Save Customer LayOut"
          .OnAction = "UpdateCustomerReport"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 95
          .Caption = "PE Details"
          .OnAction = "ColumnsPE"
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 97
          .Caption = "Ready For Service Details"
          .OnAction = "ColumnsRFS"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 94
          .Caption = "Order Dates"
          .OnAction = "ColumnsOrder"
    End With
    
    Set newButton = tBar.Controls.Add
    
    With newButton
          .FaceId = 1818
          .Caption = "Product Details"
          .OnAction = "ColumnsProduct"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 80
          .Caption = "Access Details"
          .OnAction = "ColumnsAccess"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 82
          .Caption = "CPE Details"
          .OnAction = "ColumnsCPE"
    End With
    
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 99
          .Caption = "CPE Imp / Test & TurnUp Details"
          .OnAction = "ColumnsCPEI"
    End With
    
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 5827
          .Caption = "Select Service Notificaton Forms"
          .OnAction = "SelectSNF"
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 501
          .Caption = "Make Service Notification Form"
          .OnAction = "MakeSNF"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 162
          .Caption = "PPR Notes"
          .OnAction = "Notes"
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 3983
          .Caption = "PPR Details"
          .OnAction = "Details"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 2130
          .Caption = "PPR Pipeline"
          .OnAction = "Pipeline"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 734
          .Caption = "Add Action"
          .OnAction = "AddAction"
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 508
          .Caption = "Tahiti"
          .OnAction = "Tahiti"
    End With
    
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1086
          .Caption = "E-mail Order"
          .OnAction = "MailOrd"
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1675
          .Caption = "E-mail Reports"
          .OnAction = "MailSheetCustomer"
    End With
        
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 1
          .BeginGroup = True
    End With
        
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 3897
          .Caption = "Customer Inventory Tool"
          .OnAction = "CIVT"
          .BeginGroup = True
    End With
    
    Set newButton = tBar.Controls.Add
    With newButton
          .FaceId = 52
          .Caption = "Margin Tool"
          .OnAction = "MarginTool"
    End With
    
    'display CommandBar, position on spreadsheet
    tBar.Visible = True
        
    CommandBars("CIF ToolBar").Position = msoBarTop
    Exit Sub
    
End Sub

 

[Hoornvan]

AABE,

Ik weet er niet veel van maar staat Analysis Toolpak aan gevinkt?

 

[snb]

Waarom zo moeilijk ?
Maak de werkbalk en koppel hem aan het bestand.

Zet in Workbook_open

Private Sub workbook_Open()
   application.commandbars("CIF balk").visible=true
End sub

Zet in Workbook_Close

Private Sub workbook_Open()
   application.commandbars("CIF balk").delete
End sub

En als je het toch 'tijdens de vlucht' wil doen, kan die code wel wat compacter:

Sub CifToolBar()
  With CommandBars.Add
    .Name = "CIF ToolBar"
    For j = 1 To 20
      With .Controls.Add
        .Type = Choose(j, 2950)
        .SetFocus = msoButtonCaption
        .Caption = Choose(j, "CIF Toolbar", "New Order Change Desk", "HelpFile", "Move Order from Tracker sheet to Closed Orders sheet", "Select Customer", "Refresh Information")
        .OnAction = Choose("Home", "NewBSRecord", "Help", "RemoveOrder", "SelCust", "Refresh")
        .FaceId = Choose(j, , 18, 1089, 1786, 5827, 37)
        If j = 5 Then .BeginGroup = True
      End With
    Next
  End With
End Sub