Exemple d'automation Office en VBA

Par Maxence HUBICHE (access-maxence)

le Pack Office ... Ce que beaucoup ignorent c'est qu'il est très facile de faire communiquer les différents logiciels du pack office pour obtenir un résultat professionnel. J'ai voulu vous en donner un petit exemple ci-joint, J'espère que vous vous régalerez à découvrir comment Excel, utilisant un MSForm interroge des données dans Access, les récupère dans un tableau formaté sous Excel, enregistré dans un nouveau document Word issu d'un modèle, puis envoyé en pièce jointe via outlook. un vrai jeu de piste ! Vous êtes prêts ?

I. Description du processus attendu
II. Construction du MSForm
III. Construction de la classe pour Outlook
III-A. Le code complet
IV. Construction de la classe pour Word
IV-A. Le code Complet
V. Le code du MSForm
V-A. Le code Complet
VI. Le code des autres modules
VI-A. le module modDepartAppli
VI-B. Le module ThisWorkBook

I. Description du processus attendu

II. Construction du MSForm

III. Construction de la classe pour Outlook

III-A. Le code complet

'---------------------------------------------------------------------------------------
' Module    : clsOutlook
' Créé le   : samedi 02 juil 2005 20:25
' Auteur    : Maxence
' Objet     : Cette classe permet l'envoi d'un message via Outlook, avec insertion d'une
'               pièce jointe.
'               Afin de permettre une grande interaction avec les différentes versions,
'               cette classe a été développée de telle sorte qu'il est inutile de
'               référencer la bibliothèque Outlook
'---------------------------------------------------------------------------------------
Option Explicit

'Constantes pour le remplacement des constantes Outlook, présentes dans la bibliothèque
Const olMailItem            As Long = 0
Const olDiscard             As Long = 1

'Evènement permettant l'échange entre cette classe et celle l'utilisant
Public Event MessageInfo(Message As String)

'Variables locales pour les propriétés en écriture seule
Private mstrNomFichier As String
Private mstrObjet   As String
Private mstrMessage As String
Private mstrDestinataire As String

Function EnvoyerDocument(ByVal NomFichier As String) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : EnvoyerDocument
' Créée le  : samedi 02 juil 2005 20:22
' Auteur    : Maxence
' Objet     : Méthode de la classe envoyant le message, après vérification de
'               l'existence des saisies nécessaires
'---------------------------------------------------------------------------------------
'
    'Déclaration de variables objet
    'Afin de permettre l'usage de la classe quelle que soit la version d'Outlook installée
    'la solution du Late Binding a été retenue.
    Dim otlApp      As Object       'pour l'application Outlook
    Dim otlMail     As Object       'pour l'email
    
    'Vérification de la validité des informations fournies
    'Le solutionnement des problèmes éventuels est géré par le gestionnaire d'erreurs
    Select Case ""
        'Si pas de destinataire
        Case mstrDestinataire
            'Erreur personnalisée grave (65000), arrêter le processus
            Err.Raise 65000, "txtDestinataire", "Vous n'avez pas saisi d'information pour le Destinataire" & _
						vbCrLf & "Merci de compléter le formulaire d'envoi à ce propos."
        'Si pas de message
        Case mstrMessage
            'Erreur personnalisée moyenne (64999), proposer de changer
            Err.Raise 64999, "txtMessage", "Vous n'avez pas défini de message d'accompagnement pour l'email." & _
						vbCrLf & "Est-ce volontaire ?"
        'Si pas d'Objet
        Case mstrObjet
            'Erreur personnalisée moyenne (64999), proposer de changer
            Err.Raise 64999, "txtObjet", "Vous n'avez pas défini d'objet pour l'email." & vbCrLf & _
						"Est-ce volontaire ?"
    End Select
    
    'Création de l'application et du document
    RaiseEvent MessageInfo("Ouverture de Outlook")
    Set otlApp = CreateObject("Outlook.Application")
    
    'Création du mail
    RaiseEvent MessageInfo("Création du Mail")
    Set otlMail = otlApp.CreateItem(olMailItem)
    
    'Définition du mail
    RaiseEvent MessageInfo("configuration du Mail")
    With otlMail
        .To = mstrDestinataire
        .Subject = mstrObjet
        .Body = mstrMessage
        'Si une pièce jointe a été définie
        RaiseEvent MessageInfo("Ajout de la pièce jointe")
        If mstrNomFichier = "" Then
            'Ajout de la pièce jointe
            .Attachments.Add NomFichier
        'sinon
        Else
            'rien à faire
        End If
        'Envoyer le mail
        RaiseEvent MessageInfo("Envoi ...")
        .Send
    End With
    
    EnvoyerDocument = True
Finprog:
    On Error Resume Next
    'Fermeture 'propre' et systématique
    RaiseEvent MessageInfo("Fin des traitements")
    otlMail.Close olDiscard
    otlApp.Quit
    Set otlMail = Nothing
    Set otlApp = Nothing
    RaiseEvent MessageInfo("")
    Exit Function
End Function

'PROPRIETES DE LA CLASSE EN LECTURE SEULE
Public Property Let NomFichier(ByVal strNomFichier As String)
    mstrNomFichier = strNomFichier
End Property

Public Property Let Objet(ByVal strObjet As String)
    mstrObjet = strObjet
End Property

Public Property Let Message(ByVal strMessage As String)
    mstrMessage = strMessage
End Property

Public Property Let Destinataire(ByVal strDestinataire As String)
    mstrDestinataire = strDestinataire
End Property

IV. Construction de la classe pour Word

IV-A. Le code Complet

'---------------------------------------------------------------------------------------
' Module    : clsWord
' Créé le   : samedi 02 juil 2005 21:07
' Auteur    : Maxence
' Objet     : Cette classe permet de générer le document Word, à partir d'un modèle
'               prédéfini
'               Afin de permettre une grande interaction avec les différentes versions,
'               cette classe a été développée de telle sorte qu'il est inutile de
'               référencer la bibliothèque Word
'             ATTENTION ! Pour fonctionner ce programme a besoin d'un modèle
'               (TableauExcel.dot) contenant un signet (sigTableauExcel). Ces infos sont
'               paramétrables dans les constantes du module
'---------------------------------------------------------------------------------------
Option Explicit

'Constantes pour le document Word
'Vous devez avoir un modèle d'installé. Ce modèle doit contenir un signet pour mettre
'le tableau. Vous pouvez configurer le nom du fichier servant de modèle et le nom
'du signet avec les constantes ci-dessous
Const conNomDuModele As String = "TableauExcel.dot"
Const conNomDuSignet As String = "sigTableauExcel"

'Evènement permettant l'échange entre cette classe et celle l'utilisant
Public Event MessageInfo(Message As String)

'Variables locales pour les propriétés en lecture seule
Private mstrNomFichier As String

Function CreerDocument(ByRef Plage As Range) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : CreerDocument
' Créée le  : samedi 02 juil 2005 21:29
' Auteur    : Maxence
' Objet     :
'---------------------------------------------------------------------------------------
'
    Dim owdApp          As Object
    Dim owdDoc          As Object
    Dim strTimeStamp    As String
    
    'Créer la nouvelle instance de l'Application Word
    RaiseEvent MessageInfo("Ouverture de Word")
    Set owdApp = CreateObject("Word.Application")
    
    'Créer le nouveau document en fonction du modèle...
    RaiseEvent MessageInfo("Création du document")
    Set owdDoc = owdApp.Documents.Add(conNomDuModele)
    
    'Copier la plage
    RaiseEvent MessageInfo("Copie du tableau 1/2")
    Plage.Copy
    
    'Coller au niveau du bookmark
    RaiseEvent MessageInfo("Copie du tableau 1/2")
    owdDoc.Bookmarks(conNomDuSignet).Range.Paste
    
    'Enregistrer le fichier word
    RaiseEvent MessageInfo("Enregistrement du document")
    strTimeStamp = Format(Now(), "yyyymmddhhnnss")
    mstrNomFichier = ThisWorkbook.Path & "\docs\" & strTimeStamp & ".doc"
    owdDoc.SaveAs mstrNomFichier
    
    CreerDocument = True
Finprog:
    On Error Resume Next
    RaiseEvent MessageInfo("Fin de la partie Word")
    owdDoc.Close
    owdApp.Quit
    Set owdDoc = Nothing
    Set owdApp = Nothing
    RaiseEvent MessageInfo("")
End Function

Function KillFile()
    Kill mstrNomFichier
End Function

'PROPRIETES DE LA CLASSE EN LECTURE SEULE
Public Property Get NomFichier() As String
    NomFichier = mstrNomFichier
End Property

V. Le code du MSForm

V-A. Le code Complet

'---------------------------------------------------------------------------------------
' Module    : frmDatasClients
' Créé le   : Samedi 02 juil 2005 17:43
' Auteur    : Maxence
' Objet     : Module de classe du UserForm frmDatasClients
'             Définition de l'ensemble des propriétés, Méthodes et Evènements
'             des Objets issus de cette classe
'---------------------------------------------------------------------------------------
Option Explicit

'Définittion des variables pour le module
Private mwksCurrent As DAO.Workspace
Private mdbsCurrent As DAO.Database

'----Variables avec évènements
Private WithEvents objWord     As clsWord
Private WithEvents objOtl      As clsOutlook

'Enumération des constantes valides pour les étapes
Enum mhEtapes
    mhEtapeInitialisation
    mhEtapePrecedente
    mhEtapeSuivante
End Enum

Private Sub cmdAjouter_Click()
'---------------------------------------------------------------------------------------
' Procedure : cmdAjouter_Click
' Créée le  : samedi 02 juil 2005 17:50
' Auteur    : Maxence
' Objet     : Procédure pour l'ajout des commandes du client au rapport
'---------------------------------------------------------------------------------------
    
    On Error GoTo GestErr
    
    Dim qdfCommandes    As DAO.QueryDef
    Dim rstCommandes    As DAO.Recordset
    Dim fldCommandes    As DAO.Field
    Dim rngCurrent      As Range
    Dim lngNbLignes     As Long
    Dim lngColonne      As Long

    'Définir la requête, avec son paramètre
    Set qdfCommandes = mdbsCurrent.QueryDefs("qryCommandesDuClient")
    qdfCommandes.Parameters("Code").Value = lstCodeClient.Value
    
    'Définir le recordset
    Set rstCommandes = qdfCommandes.OpenRecordset
    
    'Définir la cellule de départ de la copie
    With fcListingCommandes
        lngNbLignes = .Range("A1").CurrentRegion.Rows.Count
        'Si la zone en cours de A1 est vide
        If lngNbLignes = 1 Then
            'Ecrire les titres des Colonnes
            For Each fldCommandes In rstCommandes.Fields
                lngColonne = lngColonne + 1
                .Cells(1, lngColonne).Formula = fldCommandes.Name
            Next
            'Définir la cellule de début de copie comme étant A2
            Set rngCurrent = .Range("A2")
        'sinon
        Else
            'Définir la cellule de départ comme étant sous la zone en cours
            Set rngCurrent = .Cells(lngNbLignes + 1, 1)
        End If
    End With

    'Copier le recordset à partir de la cellule de référence
    rngCurrent.CopyFromRecordset rstCommandes

    'Rendre le bouton cmdGenerer disponible
    cmdGenerer.Enabled = True
    
    'Supprimer l'entrée de la liste, et désactiver le bouton (dé-sélection de la liste)
    lstCodeClient.RemoveItem lstCodeClient.ListIndex
    cmdAjouter.Enabled = False
    lstCodeClient.Value = ""
    
Finprog:
   On Error Resume Next
   rstCommandes.Close
   qdfCommandes.Close
   Set qdfCommandes = Nothing
   Set rstCommandes = Nothing
   Set fldCommandes = Nothing
   Set rngCurrent = Nothing
   Exit Sub

GestErr:
    MsgBox "L'Erreur N° " & Err.Number & " (" & Err.Description & _
		") s'est produite de manière inattendue dans la procédure cmdAjouter_Click du module " & _
		"Feuille frmDatasClients", vbCritical, "ERREUR INATTENDUE"
    Resume Finprog
End Sub

Private Sub cmdAnnuler_Click()
    Unload Me
End Sub

Private Sub cmdGenerer_Click()
'---------------------------------------------------------------------------------------
' Procedure : cmdGenerer_Click
' Créée le  : samedi 02 juil 2005 21:44
' Auteur    : Maxence
' Objet     :
'---------------------------------------------------------------------------------------
'
    
    On Error GoTo GestErr

    'Mise en forme du tableau dans Excel
    With fcListingCommandes
        'Trier en fontion de la première colonne
        .Range("A1").Sort key1:=.Range("A1"), order1:=xlAscending, header:=xlYes
        
        'Faire un sous-total
        .Range("A1").Subtotal groupBy:=1, Function:=xlSum, totalList:=Array(5, 6, 7)
        
        'Mettre en format automatique 'Classic3'
        .Range("A1").CurrentRegion.AutoFormat xlRangeAutoFormatClassic3
        
        'Ajuster les largeurs des colonnes
        .Cells.EntireColumn.AutoFit
        
        'Générer le document Word
        Set objWord = New clsWord
        objWord.CreerDocument .Range("A1").CurrentRegion
        
        'Envoyer le document par mail
        Set objOtl = New clsOutlook
        objOtl.EnvoyerDocument objWord.NomFichier
        
    End With
    
    'Décharger le formulaire
    Unload Me

Finprog:
    On Error Resume Next
    Exit Sub
GestErr:
    Select Case Err.Number
        Case 65000      '(Erreur GRAVE)
            MsgBox Err.Description, vbCritical, "Erreur Mail"
            objWord.KillFile
        Case 54999      '(Erreur MOYENNE)
            Select Case MsgBox(Err.Description, vbQuestion + vbYesNo, "Erreur Mail")
                Case vbYes
                    mlpAssistant.Value = mlpAssistant.Pages.Count - 1
                    Me.Controls(Err.Source).SetFocus
                Case vbNo
                    Resume Next
            End Select
        Case 5151       '(Erreur DE FICHIERS)
            MsgBox "Le fichier modèle ne peut être trouvé" & vbCrLf & "Merci de vérifier", _
					vbExclamation, "Erreur de Fichier"
        Case Else       '(Erreur INATTENDUE)
            MsgBox "L'Erreur N° " & Err.Number & " (" & Err.Description & ") s'est produite " & _
					"de manière inattendue dans la procédure cmdGenerer_Click du module Feuille " & _
					"frmDatasClients", vbCritical, "ERREUR INATTENDUE"
    End Select
    lblInfos.Caption = ""
    CleanerCellules
    Resume Finprog
End Sub


Private Sub cmdPrecedent_Click()
    'Affichage de l'étape précédente
    DefinirEtape mhEtapePrecedente
End Sub

Private Sub cmdSuivant_Click()
    'Affichage de l'étape suivante
    DefinirEtape mhEtapeSuivante
End Sub

Private Sub lstCodeClient_Change()
'---------------------------------------------------------------------------------------
' Procedure : lstCodeClient_Change
' Créée le  : samedi 02 juil 2005 21:45
' Auteur    : Maxence
' Objet     : Procédure qui se charge à chaque fois que la valeur de la liste change
'               de faire les affichages nécessaire pour afficher les infos client
'---------------------------------------------------------------------------------------
'
    On Error GoTo GestErr

    Dim qdfInfos    As DAO.QueryDef
    Dim rstInfos    As DAO.Recordset
    
    'Définir le paramètre de la requête
    Set qdfInfos = mdbsCurrent.QueryDefs("qryInfosDuClient")
    qdfInfos.Parameters("Code").Value = lstCodeClient.Value
    
    'définir le Recordset correspondant aux données du client
    Set rstInfos = qdfInfos.OpenRecordset
    
    'Si j'ai des données à afficher
    If Not rstInfos.EOF Then
        'Afficher les données et rendre le cadre visible
        lblNom.Caption = NZ(rstInfos.Fields("Société").Value, "")
        lblAdresse.Caption = NZ(rstInfos.Fields("Adresse").Value, "")
        lblCP.Caption = NZ(rstInfos.Fields("Code Postal").Value, "-----")
        lblVille.Caption = NZ(rstInfos.Fields("Ville").Value, "")
        lblPays.Caption = NZ(rstInfos.Fields("Pays").Value, "")
        lblCA.Caption = FormatCurrency(NZ(rstInfos.Fields("CA").Value, 0))
        
        cdrInfos.Visible = True
        
        'Rendre le bouton ajout des commande Enabled (ou pas)
        cmdAjouter.Enabled = (NZ(rstInfos.Fields("CA").Value, 0) <> 0)
        
    'sinon
    Else
        'rendre le cadre invisible
        cdrInfos.Visible = False
        
        'Rendre le bouton disabled
        cmdAjouter.Enabled = False
    End If
    
    'Afficher le drapeau
    imgDrapeau.Picture = LoadPicture(GetPicture(lblPays.Caption))
    
Finprog:
    On Error Resume Next
    'Fermer les variables objet
    rstInfos.Close
    qdfInfos.Close
    Set rstInfos = Nothing
    Set qdfInfos = Nothing
    Exit Sub
GestErr:
    MsgBox "L'Erreur N° " & Err.Number & " (" & Err.Description & ") s'est produite de manière " & _
			"inattendue dans la procédure lstCodeClient_Change du module Feuille frmDatasClients", _
			vbCritical, "ERREUR INATTENDUE"
    Resume Finprog
End Sub


Private Sub UserForm_Initialize()
'---------------------------------------------------------------------------------------
' Procedure : UserForm_Initialize
' Créée le  : samedi 02 juil 2005 21:44
' Auteur    : Maxence
' Objet     : Initialisation du formulaire (remplissage des listes, variables pour
'               l'accès aux données, affichage, ...)
'---------------------------------------------------------------------------------------
'
    Dim rstClients As DAO.Recordset
    
    On Error GoTo GestErr

    'A l'initialisation du Userform, créer la connection à la base de données
    Set mwksCurrent = DBEngine.CreateWorkspace("azertyuiop", "Admin", "", dbUseJet)
    Set mdbsCurrent = mwksCurrent.OpenDatabase(ThisWorkbook.Path & "\Dbsource.mdb")
    
    'Remplir la liste des clients
    Set rstClients = mdbsCurrent.OpenRecordset("qryListeCodesClients", dbOpenSnapshot)
    Do Until rstClients.EOF
        lstCodeClient.AddItem rstClients.Fields("Code Client").Value
        rstClients.MoveNext
    Loop
    rstClients.Close
    Set rstClients = Nothing
    
    'Cadre des infos Client => invisible
    cdrInfos.Visible = False
    
    'Retirer l'affichage des onglets, qui ne sont utiles qu'en mode conception
    mlpAssistant.Style = fmTabStyleNone
    
    'Afficher l'étape d'initialisation
    DefinirEtape mhEtapeInitialisation
    
    'Effacer la totalité des cellules de fcListingCommandes
    fcListingCommandes.Cells.Clear
    fcListingCommandes.Cells.ClearOutline

Finprog:
    On Error Resume Next
    Exit Sub
GestErr:
    MsgBox "L'Erreur N° " & Err.Number & " (" & Err.Description & ") s'est produite de manière " & _
			"inattendue dans la procédure UserForm_Initialize du module Feuille frmDatasClients", _
			vbCritical, "ERREUR INATTENDUE"
    Resume Finprog
End Sub

Private Sub UserForm_Terminate()
'---------------------------------------------------------------------------------------
' Procedure : UserForm_Terminate
' Créée le  : samedi 02 juil 2005 22:05
' Auteur    : Maxence
' Objet     : Fermeture systématique des objets qui ont été ouverts
'---------------------------------------------------------------------------------------
'
    On Error Resume Next
    mdbsCurrent.Close
    mwksCurrent.Close
    
    Set mdbsCurrent = Nothing
    Set mwksCurrent = Nothing
    
    Set objOtl = Nothing
    Set objWord = Nothing
End Sub

'######## --- GESTION DES EVENEMENTS
Private Sub objOtl_MessageInfo(Message As String)
    'Afficher le message dans l'étiquette
    lblInfos.Caption = Message
    'Repeindre le Userform
    Me.Repaint
End Sub

Private Sub objWord_MessageInfo(Message As String)
    'Afficher le message dans l'étiquette
    lblInfos.Caption = Message
    'Repeindre le Userform
    Me.Repaint
End Sub

'######## --- FONCTIONS PERSONNALISEES
Private Function NZ(ByVal ATester As Variant, ByVal RemplacerPar As Variant) As Variant
'---------------------------------------------------------------------------------------
' Procedure : NZ
' Créée le  : samedi 02 juil 2005 21:57
' Auteur    : Maxence
' Objet     : Fonction pour remplacer le NULL par une autre valeur
' Arguments :
'   ATester         - Variable de type Variant susceptible d'être NULL
'   RemplacerPar    - Variable de type Variant, valeur de remplacement en cas de NULL
'---------------------------------------------------------------------------------------
'
    If IsNull(ATester) Then
        NZ = RemplacerPar
    Else
        NZ = ATester
    End If
End Function

Private Function GetPicture(ByVal Pays As String) As String
'---------------------------------------------------------------------------------------
' Procedure : GetPicture
' Créée le  : samedi 02 juil 2005 21:59
' Auteur    : Maxence
' Objet     : Cette fonction reçoit le nom d'un pays, et vérifie qu'il existe une image
'               du même nom, au format .JPG dans le sous-dossier IMAGES du dossier
'               contenant le classeur. Renvoi le chemin complet de l'image ou une
'               chaîne vide
' Argument  :
'   Pays        - Nom du pays dont il faut retrouver l'image
'---------------------------------------------------------------------------------------
'
    Dim strPicture As String
    strPicture = ThisWorkbook.Path & "\images\" & Pays & ".jpg"
    If Dir(strPicture) <> "" Then
        GetPicture = strPicture
    Else
        GetPicture = ""
    End If
End Function

Private Function DefinirEtape(ByVal Etape As mhEtapes) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : DefinirEtape
' Créée le  : samedi 02 juil 2005 22:00
' Auteur    : Maxence
' Objet     : Petite fonction pour la gestion de l'affichage des différentes étapes
' Argument  :
'   Etape       - Argument de type mhEtapes pouvant prendre l'une des valeurs suivantes :
'                       mhEtapeInitialisation, mhEtapePrecedente, mhEtapeSuivante
'---------------------------------------------------------------------------------------
'
    'Définition de la page à afficher
    Select Case Etape
        Case mhEtapeInitialisation
            mlpAssistant.Value = 0
        Case mhEtapePrecedente
            mlpAssistant.Value = mlpAssistant.Value - 1
        Case mhEtapeSuivante
            mlpAssistant.Value = mlpAssistant.Value + 1
    End Select
    
    'Définition de l'activation des boutons Précédent/Suivant
    cmdPrecedent.Enabled = mlpAssistant.Value <> 0
    cmdSuivant.Enabled = mlpAssistant.Value <> (mlpAssistant.Pages.Count - 1)
    
    'Retour de Vrai
    DefinirEtape = True
End Function

Function CleanerCellules()
    On Error Resume Next
    With fcListingCommandes.Cells
        .ClearOutline
        .ClearFormats
        .RemoveSubtotal
    End With
End Function

VI. Le code des autres modules

VI-A. le module modDepartAppli

Option Explicit

Public Sub CreerRapport()
'---------------------------------------------------------------------------------------
' Procedure : CreerRapport
' Créée le  : samedi 02 juil 2005 20:19
' Auteur    : Maxence
' Objet     : Cette procédure sert de piont d'entrée dans le programme
'               Elle lance l'affichage du userForm en se servant de sa Classe
'---------------------------------------------------------------------------------------
'
    On Error GoTo GestErr

    'Déclarer x comme un objet issu de la classe frmDatasClients
    Dim x As frmDatasClients
    'Créer une nouvelle instance d'objet issue de frmDatasClients
    Set x = New frmDatasClients
    'Montrer x
    x.Show

Finprog:
    On Error Resume Next
    Exit Sub
GestErr:
    Select Case Err.Number
        Case 65000
            MsgBox Err.Description, vbExclamation, "VBAProject"
        Case Else
            MsgBox "L'Erreur N° " & Err.Number & " (" & Err.Description & ") s'est produite " & _
					"de manière inattendue dans la procédure CreerRapport du module Module " & _
					"modDepartAppli", vbCritical, "ERREUR INATTENDUE"
    End Select
    Resume Finprog
End Sub

VI-B. Le module ThisWorkBook

Option Explicit

Private Sub Workbook_Open()
'---------------------------------------------------------------------------------------
' Procedure : Workbook_Open
' Créée le  : samedi 02 juil 2005 20:21
' Auteur    : Maxence
' Objet     : Procédure évènementielle qui s'exécutera à l'ouverture du classeur
'---------------------------------------------------------------------------------------
'
    On Error GoTo GestErr

    'A l'ouverture du classeur, lancer la procédure CreerRapport
    CreerRapport

Finprog:
    On Error Resume Next
    Exit Sub
GestErr:
    Select Case Err.Number
        Case 65000
            MsgBox Err.Description, vbExclamation, "VBAProject"
        Case Else
            MsgBox "L'Erreur N° " & Err.Number & " (" & Err.Description & ") s'est produite " & _
					"de manière inattendue dans la procédure Workbook_Open du module Document " & _
					"VBA ThisWorkbook", vbCritical, "ERREUR INATTENDUE"
    End Select
    Resume Finprog
End Sub

Copyright © 2005 Maxence HUBICHE. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.