Liens Excel - Access

**davcar14** · 23/06/2008, 18h19

Bonsoir le forum,

Est-il possible de tester l'origine du lancement d'Excel sur le poste de travail ?

Je m'explique. J'ai une application Access qui crée automatiquement une multitude de fichiers Excel à destination d'un certain nombre de gestionnaires.

Ces gestionnaires doivent mettre à jour les fichiers, les faire signer electroniquement par leur responsable et me les renvoyer.

Pour les aider, j'ai une procédure dans le fichier Excel qui contrôle si chaque onglet a bien été validé. Le cas échéant, j'ai une msgbox qui s'affiche à la clôture pour signaler les onglets non validés. Cette procédure est déclenchée par l'évènement BeforeClose.

Mon problème se situe au niveau de la création des fichiers Excel par Access. Lorsque je ferme chaque fichier, j'ai la msgbox qui s'affiche vu que la signature n'a pas eu lieu.

La question que je me pose, c'est dans Excel, est ce que je suis capable de savoir que j'ai été lancé par Access, ce qui me permettrait de court-circuiter le contrôle ?
sinon, est-ce que quelqu'un a une idée de comment éviter d'afficher cette msgbox lors de la création automatique des documents ?

Par avance, merci et bonne soirée à tous.
David.

**JackOuYA** · 23/06/2008, 18h43

Bonjour,

tu as du créer une procédure événementielle sur le onclose de ton classeur ... non

crée par exemple un Flag flagQuitDepuisAccess .. et teste sa valeur le principe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
'La fonction événementielle sur le on close
 .._onclose
 
if not flagQuitDepuisAccess then 
    'Ton test d'onglet
end if
...

une prodédure de fin appelé par Access

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Sub FinAccess
flagQuitDepuisAccess = true
quit
en sub

penser à déclarer de maniére globale ce flag par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Dim flagQuitDepuisAccess as boolean

Jacques.

**davcar14** · 26/06/2008, 16h09

Je n'ai pas compris comment le "flagQuitDepuisAccess" va passer de Access à Excel parce que le code que je veux "intercepter" est codé dans le classeur Excel alors que l'instruction de clôture du classeur est initiée dans Access.
Y'a t il un moyen de passer la valeur du flagQuitDepuisAccess entre Access et Excel.

Voilà le code du classeur:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
    On Error GoTo Err_Workbook_BeforeClose
 
    Dim Ws As Worksheet
    Dim Wb As Workbook
 
    Dim Visa_Rsp As String
    Dim Resp As String
    Dim Msg As String
    Dim I As Long
    Dim J As Long
    Dim Nb As Long
    Dim Trouve As Boolean
 
    If Not flagQuitDepuisAccess Then
 
        Set Wb = ThisWorkbook
        Nb = 0
 
        Application.ScreenUpdating = False
 
        For Each Ws In Wb.Worksheets
 
            Trouve = False
            I = 1
            J = 1
 
            If Ws.Name <> "PARAM" Then
 
                Do Until Trouve
 
                    If Ws.Cells(I, J) = "Nom et visa du Gestionnaire" Then
                        Trouve = True
                    End If
 
                    If Trouve = False Then
                        I = I + 1
                        If I > 2500 Then
                            I = 1
                            J = J + 1
                        End If
                    End If
 
                Loop
 
                Trouve = False
 
                Do Until Trouve
 
                    If Ws.Cells(I, J) = "Nom et visa du Responsable d'Activité" Then
                        Trouve = True
                    End If
 
                    If Trouve = False Then
                        J = J + 1
                    End If
 
                Loop
 
                Visa_Rsp = Ws.Cells(I + 4, J)
                Resp = Lire_Param()
 
                If Visa_Rsp <> Resp Then
                       Msg = Msg & Ws.Name & Chr(130) & Chr(13)
                       Nb = Nb + 1
                End If
 
            End If
 
        Next Ws
 
        If Msg <> "" Then
            If Nb = 1 Then
                Msg = "L'état d'analyse suivant n'est pas validé:" & Chr(13) & Msg & Chr(13) & "Veuillez vérifier."
                MsgBox Msg, vbExclamation
            Else
                Msg = "Les états d'analyse suivants ne sont pas validés:" & Chr(13) & Msg & Chr(13) & "Veuillez vérifier."
                MsgBox Msg, vbExclamation
            End If
        End If
    End If
 
Exit_Workbook_BeforeClose:
    Exit Sub
Err_Workbook_BeforeClose:
    MsgBox Err.Description, vbCritical, "Erreur Workbook_Close " & Err.Number
     Resume Exit_Workbook_BeforeClose
End Sub

Dans Access, le code de création du fichier est le suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
    Set xlApp = CreateObject("Excel.application")
 
        xlApp.Visible = False
 
        Set xlBook = xlApp.Workbooks.Open(Application.CurrentProject.Path & "\Etats_Analyse.XLS")
 
        nf = 1
 
        Set xlSheet = xlBook.Worksheets("PARAM")
 
        '-----------------------------------------------------------------------------------------------------------------
        '------------------------------ DU FEUILLET PARAM POUR GESTION HABILITATION --------------------------------------
        '-----------------------------------------------------------------------------------------------------------------
        Dim rv As Recordset
        Set rv = db.OpenRecordset("R100", dbOpenDynaset)
        rv.FindFirst "[Gestionnaire]='" & Serv & "'"
        rg = 1
        Do Until rv.NoMatch
            rg = rg + 1
            xlApp.Sheets("PARAM").Range("A" & rg) = Serv
            xlApp.Sheets("PARAM").Range("B" & rg) = rv.Fields("User")
            xlApp.Sheets("PARAM").Range("C" & rg) = rv.Fields("NomPrenom")
            rv.FindNext "[gestionnaire]='" & Serv & "'"
        Loop
        rv.Close
 
        If rg = 1 Then
            XL_Recap = "ATTENTION tables T_Agents et T_Gestion_Visa incomplètes : Service " & Serv & " sans VISA USER"
        Else
            XL_Recap = ""
        End If
 
        '-----------------------------------------------------------------------------------------------------------------
        '--------------------------------   OUVERTURE REQUETE RECAP PAR SERVICE   ----------------------------------------
        '-----------------------------------------------------------------------------------------------------------------
 
        Set r01 = db.OpenRecordset("RM508", dbOpenDynaset)
        critere1 = "[Periode]=" & Chr(39) & AM & Chr(39) & " and [service]=" & Chr(39) & Serv & Chr(39)
        r01.FindFirst critere1
 
        '-----------------------------------------------------------------------------------------------------------------
        '--------------------------------   OUVERTURE REQUETE DETAIL DES COMPTES   ---------------------------------------
        '-----------------------------------------------------------------------------------------------------------------
 
        Set r04 = db.OpenRecordset("RM411", dbOpenDynaset)
        critere1 = "[Periode]=" & Chr(39) & AM & Chr(39) & " and [service]=" & Chr(39) & Serv & Chr(39)
        r04.FindFirst critere1
 
        '-----------------------------------------------------------------------------------------------------------------
        '--------------------------------   INITIALISATION DES VARIABLES   -----------------------------------------------
        '-----------------------------------------------------------------------------------------------------------------
 
        lu = 0
        rg = 10
        rl = 10
        entete_zero = 0
        entete_liste = 0
        entete_auto = 0
        entete_67 = 0
 
        Do Until r04.NoMatch
 
            If entete_liste = 0 Then
 
                'inscrit sur la liste des comptes du service
 
                nomModele = Application.CurrentProject.Path & "\LISTE.xlt"
                xlBook.Sheets.Add after:=xlBook.Sheets(nf), Type:=nomModele
                nf = nf + 1
                ' ---- Masque la feuille PARAM vu que la liste est présente
                xlBook.Sheets("PARAM").Visible = False
                xlBook.Sheets("LISTE").Cells(4, 2).Value = r01.Fields("Libelle_long")
                xlBook.Sheets("LISTE").Cells(4, 6).Value = r01.Fields("Service")
                xlBook.Sheets("LISTE").Cells(6, 3).Value = Transco_Date(AM)
                xlBook.Sheets("LISTE").Cells(15, 1).Value = r01.Fields("User_Responsable")
                xlBook.Sheets("LISTE").Cells(20, 1).Value = r01.Fields("Tel_Rsp")
                xlBook.Sheets("LISTE").Cells(15, 5).Value = r01.Fields("User_Resp_Acti")
                xlBook.Sheets("LISTE").Cells(20, 5).Value = r01.Fields("Tel_Ra")
 
                entete_liste = 1
 
            End If
 
            ' insertion ligne pour agrandir le tableau
            xlBook.Sheets("LISTE").Range("A" & rl + 1 & ":F" & rl + 1).EntireRow.Insert shift:=xlShiftDown
            xlBook.Sheets("LISTE").Range("C" & rl + 1 & ":D" & rl + 1).MergeCells = True
            xlBook.Sheets("LISTE").Range("A" & rl + 1 & ":F" & rl + 1).Borders(xlEdgeLeft).Weight = xlMedium
            xlBook.Sheets("LISTE").Range("A" & rl + 1 & ":F" & rl + 1).Borders(xlEdgeTop).Weight = xlThin
            xlBook.Sheets("LISTE").Range("A" & rl + 1 & ":F" & rl + 1).Borders(xlEdgeBottom).Weight = xlThin
            xlBook.Sheets("LISTE").Range("A" & rl + 1 & ":F" & rl + 1).Borders(xlEdgeRight).Weight = xlMedium
            xlBook.Sheets("LISTE").Range("A" & rl + 1 & ":F" & rl + 1).Borders(xlInsideVertical).Weight = xlMedium
 
 
            ' inscrit le compte dans le tableau
            xlBook.Sheets("LISTE").Cells(rl, 1) = r04.Fields("Compte")
            xlBook.Sheets("LISTE").Cells(rl, 2) = r04.Fields("Type")
            xlBook.Sheets("LISTE").Cells(rl, 3) = r04.Fields("Libelle")
            xlBook.Sheets("LISTE").Cells(rl, 5) = r04.Fields("Solde_Debit")
            xlBook.Sheets("LISTE").Cells(rl, 6) = r04.Fields("Solde_Credit")
 
            rl = rl + 1
 
        '-----------------------------------------------------------------------------------------------------------------
        '---------------------------------   EN FONCTION DU FORMULAIRE A UTILISER   -------------------------------------
        '-----------------------------------------------------------------------------------------------------------------
 
            Select Case r04.Fields("Form")
 
                Case "0"                        ' Compte comptable a zéro
 
                    If entete_zero = 0 Then
 
                        xlBook.Sheets.Add after:=xlBook.Sheets("LISTE"), Type:=Application.CurrentProject.Path & "\zero.xlt"
                        nf = nf + 1
 
                        xlBook.Sheets("ZERO").Cells(4, 2).Value = r01.Fields("Libelle_long")
                        xlBook.Sheets("ZERO").Cells(4, 6).Value = r01.Fields("Service")
                        xlBook.Sheets("ZERO").Cells(6, 3).Value = Transco_Date(AM)
                        xlBook.Sheets("ZERO").Cells(15, 1).Value = r01.Fields("User_Responsable")
                        xlBook.Sheets("ZERO").Cells(20, 1).Value = r01.Fields("Tel_Rsp")
                        xlBook.Sheets("ZERO").Cells(15, 5).Value = r01.Fields("User_Resp_Acti")
                        xlBook.Sheets("ZERO").Cells(20, 5).Value = r01.Fields("Tel_Ra")
                        entete_zero = 1
 
                    End If
 
                    lu = lu + 1
                    Forms!F_XL_OUT_CPTA!ProgressBar.Value = Int(((lu + lu1) / (nBil + nres + ndt)) * 100)
                    Forms!F_XL_OUT_CPTA.Repaint
 
                    ' Insertion ligne pour agrandir le tableau
                    xlBook.Sheets("ZERO").Range("A" & rg + 1 & ":F" & rg + 1).EntireRow.Insert shift:=xlShiftDown
                    xlBook.Sheets("ZERO").Range("C" & rg + 1 & ":F" & rg + 1).MergeCells = True
                    xlBook.Sheets("ZERO").Range("A" & rg + 1 & ":F" & rg + 1).Borders(xlEdgeLeft).Weight = xlMedium
                    xlBook.Sheets("ZERO").Range("A" & rg + 1 & ":F" & rg + 1).Borders(xlEdgeRight).Weight = xlMedium
                    xlBook.Sheets("ZERO").Range("A" & rg + 1 & ":F" & rg + 1).Borders(xlEdgeTop).Weight = xlThin
                    xlBook.Sheets("ZERO").Range("A" & rg + 1 & ":F" & rg + 1).Borders(xlEdgeBottom).Weight = xlThin
                    xlBook.Sheets("ZERO").Range("A" & rg + 1 & ":F" & rg + 1).Borders(xlInsideVertical).Weight = xlMedium
 
                    ' Ajout du compte sur la liste a zero
                    xlBook.Sheets("ZERO").Cells(rg, 1).Value = r04.Fields("Compte")
                    xlBook.Sheets("ZERO").Cells(rg, 2).Value = r04.Fields("Type")
                    xlBook.Sheets("ZERO").Cells(rg, 3).Value = r04.Fields("Libelle")
 
                    ' Creation du lien hypertext sur LISTE
                    lien = "#'ZERO'!A" & rg
                    xlBook.Sheets("LISTE").Hyperlinks.Add anchor:=xlBook.Sheets("LISTE").Cells(rl - 1, 1), Address:=lien
 
                    rg = rg + 1
 
                Case "1"                        ' Compte comptable standard
 
                    xlBook.Sheets.Add after:=xlBook.Sheets(nf), Type:=Application.CurrentProject.Path & "\Justif.xlt"
                    nf = nf + 1
                    xlBook.Sheets(nf).Name = r04.Fields("Compte")
 
                    xlBook.Sheets(nf).Cells(4, 2).Value = r01.Fields("Libelle_long")
                    xlBook.Sheets(nf).Cells(4, 8).Value = r01.Fields("Service")
                    xlBook.Sheets(nf).Cells(6, 2).Value = r04.Fields("Compte")
                    xlBook.Sheets(nf).Cells(6, 6).Value = r04.Fields("Libelle")
                    xlBook.Sheets(nf).Cells(8, 3).Value = Transco_Date(AM)
                    xlBook.Sheets(nf).Cells(42, 1).Value = r01.Fields("User_Responsable")
                    xlBook.Sheets(nf).Cells(47, 1).Value = r01.Fields("Tel_Rsp")
                    xlBook.Sheets(nf).Cells(42, 7).Value = r01.Fields("User_Resp_Acti")
                    xlBook.Sheets(nf).Cells(47, 7).Value = r01.Fields("Tel_Ra")
 
                    If r04.Fields("Solde_debit") <> 0 Then
                        xlBook.Sheets(nf).Cells(39, 7).Value = r04.Fields("Solde_debit")
                    End If
 
                    If r04.Fields("Solde_credit") <> 0 Then
                        xlBook.Sheets(nf).Cells(39, 8).Value = r04.Fields("Solde_credit")
                    End If
 
                    lu = lu + 1
                    Forms!F_XL_OUT_CPTA!ProgressBar.Value = Int(((lu + lu1) / (nBil + nres + ndt)) * 100)
                    Forms!F_XL_OUT_CPTA.Repaint
 
                    ' Creation du lien hypertext sur LISTE
                    lien = "#'" & r04.Fields("Compte") & "'!A13"
                    xlBook.Sheets("LISTE").Hyperlinks.Add anchor:=xlBook.Sheets("LISTE").Cells(rl - 1, 1), Address:=lien
 
                Case Else
 
            End Select
 
            r04.FindNext critere1
 
        Loop
 
        If lu > 0 Then
            xlBook.SaveAs Application.CurrentProject.Path & "\Emission\Etats_Analyse_" & AM & "_" & Serv & ".XLS"
        End If
 
        r04.Close
 
        xlBook.Close False

Merci d'avance pour vos éclaircissements.
David

**davcar14** · 01/07/2008, 10h06

Finalement, j'ai contourné le problème car nous ne sommes que deux à être autorisés à lancer la création des fichiers Excel. J'ai donc testé les users des deux personnes concernées pour exclure le test de cloture.
Merci.

Liens Excel - Access

Macros et VBA Excel

Discussions similaires

Partager

Partager