Public CalcTaskID
Public Const MyCommandBarName As String = "SDIS 44 - © 2009"
Private Sub DeleteMyCommandBar()
' Efface la barre d'outils MyCommandBarName
On Error Resume Next
Application.CommandBars(MyCommandBarName).Delete
On Error GoTo 0
End Sub
Sub CreateMyCommandBar()
' Création de la barre d'outils personnalisée MyCommandBarName
Dim CB As CommandBar, cc As CommandBarButton
Application.ScreenUpdating = False
DeleteMyCommandBar ' au cas où celle-ci existe déjà
Set CB = Application.CommandBars.Add(MyCommandBarName, msoBarFloating, False, True)
AddMenuToCommandBarFormats CB, True
End Sub
Private Sub AddMenuToCommandBarFormats(CB As CommandBar, blnBeginGroup As Boolean)
' adds a menu to a commandbar, duplicate this procedure for each menu you want to create
Dim m As CommandBarPopup, mi As CommandBarButton
If CB Is Nothing Then Exit Sub
With CB
Set cc = CB.Controls.Add(msoControlButton, , , , True)
With cc
.BeginGroup = True
.OnAction = "brigitte"
.Caption = "Ajouter des lignes"
.TooltipText = "Permet d'ajouter des lignes."
.Style = msoButtonIconAndCaption
.FaceId = 296
End With
' Création menu
Set cc = CB.Controls.Add(msoControlButton, , , , True)
With cc
.BeginGroup = blnBeginGroup
.Caption = "Créer les étiquettes"
.OnAction = "Publipostage"
.TooltipText = "Permet de créer des étiquettes pour archives."
.FaceId = 590
.Style = msoButtonIconAndCaption
End With
Set cc = CB.Controls.Add(msoControlButton, , , , True)
With cc
.BeginGroup = blnBeginGroup
.OnAction = "StartCalculator"
.TooltipText = "Permet d'effectuer des opérations mathématiques."
.FaceId = 283
.Style = msoButtonIcon
End With
.Visible = True
.Left = 650 ' the left position of the commandbar
.Top = 210 ' the right position of the commandbar
End With
Set cc = Nothing
Set CB = Nothing
Set cx = Nothing
End Sub
Sub StartCalculator()
Dim AppFile As String
AppFile = "Calc.exe"
On Error Resume Next
AppActivate "Calculatrice"
If Err <> 0 Then
Err = 0
CalcTaskID = Shell(AppFile, 1)
If Err <> 0 Then MsgBox "Impossible de lancer la calculatrice"
End If
End Sub