Une horloge dans la barre d'outil d'excel, comme exemple de l'utilisation de la propriéte "isaddin"

Télécharger le projet
Commenter

Description

Bonjour,

ici l'interet n'est pas dans l'horloge en elle même mais dans l'utilisation de la proprété IsAddin qui permet d'utiliser un fichier.xls comme une macro complémentaire.

Vous trouverez aussi dans ce fichier une méthode de création de bouton de barre d'outil et de gestion de ce/ces bouton(s) lié au fichier lui même(Activation ou création).

Enfin vous trouverez un exemple simple d'utilisation des API :

SetTimer
KillTimer

Pour utiliser cette source il suffit d'ouvrir le fichier excel... l'horloge démarre... pour l'arrêter il suffit de cliquer sur le bouton lui même(Caption: heure + date).

A+

3ddI7IHd

Source / Exemple : 


'Dans ThisWorkbook :

Option Explicit

Sub Workbook_Open()
    Dim Cmdbar As CommandBar
    Dim Bouton As CommandBarButton
    'on transforme ce fichier en macro complémentaire
    ThisWorkbook.IsAddin = True
    ' on prend en compte les versions anterieurs à la version 10
    ' les versions précédentes n'acceptent pas la création d'une nouvelle barre à ce stade
    If Val(Application.Version) > 9 Then
        'Tentative d'affichage de la barre
        On Local Error Resume Next
        With Application.CommandBars("Horloge")
            .Visible = True
            .Controls(1).OnAction = "StopHeure"
        End With
        If Not Err = 0 Then 'la barre n'existe pas alors on la creer
            Set Cmdbar = Application.CommandBars _
                .Add(Name:="Horloge", Position:=msoBarFloating, Temporary:=False)
            
            'Ajout du bouton dans la barre d'outils
            Set Bouton = Cmdbar.Controls.Add(Type:=msoControlButton)
            With Bouton
                .Style = msoButtonCaption
                .OnAction = "StopHeure"
                .Width = 50 'taille du bouton
            End With
            'la barre est prète... on l'affiche
            Cmdbar.Visible = True
        End If
    Else
        'les versions antérieurs
        AddTimeInCmdBar
    End If
    'préparation et lancement du timer
    UpDateTimeFormat = "HH:MM:SS"
    UpDateDateFormat = "DD MMMM YYYY"
    SetTimer Application.hWnd, 0, 1000, AddressOf UpDateTime
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    KillTimer Application.hWnd, 0
    On Error Resume Next
    Application.CommandBars("Horloge").Visible = False
    'ThisWorkbook.IsAddin = False
End Sub

'__________________________________________________________________
'__________________________________________________________________
'Dans un module:

Option Explicit

Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Public UpDateTimeFormat As String, UpDateDateFormat As String

Public Sub UpDateTime(ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
    On Error Resume Next
    Application.CommandBars("Horloge").Controls(1).Caption = Format(Time, UpDateTimeFormat) & "  " & Format(Date, UpDateDateFormat)
    DoEvents
End Sub
Sub TimerKiller()
    'il est difficile de travailler dans le VBE une fois le timer demarré
    'Dans ce cas il est préférable de le tuer. Cette macro ne sert donc qu'à cela.
    KillTimer Application.hWnd, 0
End Sub
Sub StopHeure()
    'l'heure et la date sont affichés sur le bouton. une action sur ce bouton arrete le timer et ferme le fichier
    Dim Reponse As VbMsgBoxResult
    Reponse = MsgBox("Cette action arretera l'horloge ! " & vbCrLf & vbCrLf & _
        "Voulez-vous continuer ? ", vbQuestion + vbYesNo)
    If Reponse = vbYes Then ThisWorkbook.Close False
End Sub
Sub AddTimeInCmdBar()
    'Pour les versions antérieurs à XL10
    Dim Cmdbar As CommandBar
    Dim Bouton As CommandBarButton
    On Local Error Resume Next
    With Application.CommandBars("Horloge")
        .Visible = True
        .Controls(1).OnAction = "StopHeure"
    End With
    If Not Err = 0 Then
        Set Cmdbar = CommandBars.Add(Name:="Horloge", Position:=msoBarFloating, Temporary:=True)
        Set Bouton = Cmdbar.Controls.Add(Type:=msoControlButton)
        With Bouton
            .Style = msoButtonCaption
            .OnAction = "StopHeure"
            .Width = 50
        End With
        Cmdbar.Visible = True
        End With
    End If
End Sub

Conclusion :


Rien de bien compliqué !
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (bigfish_le vrai)