'=====================================================================================================
' WAT DOET DIT SCRIPT: Laat icons zien. Doe niet meer dan 300 icons te gelijk. Start bij de waarde 1.
'------------------------------------------------------------------------------------------------------
' HOE DIT SCRIPT TE GEBRUIKEN:
' 1. INPUT: N.V.T
' 2. OUTPUT: Button in Excel
' 3. PARAMETRS: N.V.T
'-----------------------------------------------------------------------------------------------------
' NAAM: A_InstallButton.VBS
' AUTEUR: Roberto Pibia
' VERSIE TEMPLATE: 1.0
' COMMENTAAR 26-02-2010,
' VERSIE TEMPLATE: x.x
' COMMENTAAR
'
'=====================================================================================================
'On Error Resume Next
Const cmdBarName = "wbDIS"
Const cmdBarStyleStandard = 0
Const cmdBarStyleIconOnly = 1
Const cmdBarStyleCaptionOnly = 2
Const cmdBarStyleIconAndCaption = 3
Const cmdBarPositionLeft = 0
Const cmdBarPositionTop = 1
Const cmdBarPositionRight = 2
Const cmdBarPositionBottom = 3
Const cmdBarPositionFLoating = 4
Const cmdBarProtectionOff = 0
Const cmdBarProtectionOn = 1
Const cmdBarIconNr = 39
Dim oXL
Dim oAddin
Set oXL = CreateObject("Excel.Application")
createMenuBar
'Sub to install the button
'---------------------------------------------------
Sub createMenuBar()
Dim wbDIS, bExists, a, b
bExists = False
For Each bar In oXL.CommandBars
If bar.Name = cmdBarName Then
bExists = True
End If
Next
If bExists = False Then
oXL.CommandBars.Add(cmdBarName)
'oXL.CommandBars(cmdBarName).Name = "Roberto"
oXL.CommandBars(cmdBarName).Position = cmdBarPositionTop
oXL.CommandBars(cmdBarName).Visible = True
oXL.CommandBars(cmdBarName).Protection = cmdBarProtectionOff
End If
Set wbDIS = oXL.CommandBars.Item(cmdBarName)
b=1
for a = 1 to 300 ' Do not use large accounts please change this forloop to see more icons.
wbDIS.Controls.Add
wbDIS.Controls(b).DescriptionText = a
wbDIS.Controls(b).OnAction = "OpslaanInDis"
wbDIS.Controls(b).Caption = a
wbDIS.Controls(b).Style = cmdBarStyleIconAndCaption
wbDIS.Controls(b).FaceId = a
b =b+ 1
Next
Set wbDIS = Nothing
End Sub
oXL.Quit
Set oXL = Nothing
Comments