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

Soyez le premier à donner votre avis sur cette source.

Vue 8 203 fois - Téléchargée 894 fois

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é !

Codes Sources

Ajouter un commentaire Commentaires
Messages postés
4
Date d'inscription
lundi 3 novembre 2008
Statut
Membre
Dernière intervention
12 mars 2012

Bonjour,

Merci bigfish_le vrai, ta suggestion fonctionne impeccablement !
Beau bout de code à conserver.
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
Bonjour,

oui effectivement LUCHIXON, renseignement pris tu as raison. Par contre la propriété "Caption" est utilisable pour l'application excel de la version XL2000 donc:

En haut du module1(mais après Option Explicit) tu ajoutes:

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

un peu plus bas dans ce même module tu déclares une nouvelle variable public :

Public ThisXlhWnd As Long

Puis dans la sub "Workbook_Open()" de "ThisWorkBook" tu remplace la ligne:

SetTimer Application.hWnd, 0, 1000, AddressOf UpDateTime

par les 2 lignes suivantes:

ThisXlhWnd = FindWindow(vbNullString, Application.Caption)
SetTimer ThisXlhWnd, 0, 1000, AddressOf UpDateTime

enfin dans la Sub "Workbook_BeforeClose(Cancel As Boolean)" de ce même "ThisWorkBook" remplace la ligne

KillTimer Application.hWnd, 0

Par les 2 lignes suivantes:

ThisXlhWnd = FindWindow(vbNullString, Application.Caption)
KillTimer ThisXlhWnd, 0

Essai et tien moi informé

A+
Messages postés
4
Date d'inscription
lundi 3 novembre 2008
Statut
Membre
Dernière intervention
12 mars 2012

Bonjour,

Avec la version 2000 d'Excell, j'obtiens l'erreur suivante :

Erreur d'exécution '438':
Propriété ou méthode non gérée par cet objet.

A la ligne :
SetTimer Application.hWnd, 0, 1000, AddressOf UpDateTime

Après vérification dans l'explorateur d'objet, 'Application' ne possède pas la propriété 'hwnd'

Une idée ?

Merci
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
Merci ADN56 :)
Messages postés
1172
Date d'inscription
jeudi 24 mai 2007
Statut
Membre
Dernière intervention
28 septembre 2013
1
bonne idée, code à garder sous le coude, merci.

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.