Script to display button icons in Excell and there corespondif numbers with vbs
3/8/2010 | Submitted By robesini
 
'=====================================================================================================
' 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


Printer Friendly Version
 
Problem? Question? Comment? Please, let us know!
Return to AppDeploySM Tips and Tricks.