[AC-2016] Automation avec Excel : erreurs aleatoires

Automation avec Excel : erreurs aleatoires

Bonjour

Lors de l’exécution du code ci-dessous différentes erreurs apparaissent aléatoirement (erreur 1004 , erreur objet with non défini sur la ligne"With WK.ActiveWorkbook.ActiveSheet", etc...):

J'ai cru comprendre que s'agissant d'une automation vers Excel il fallait spécifier correctement chaque range et bien référencer la feuille en création, pourriez vous m'aiguiller quant à la méthode la plus correcte à utiliser ?

Code:

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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
Public Sub exportFDRExcel()
 
MsgBox sqlFDR
Me.LstEtatsProspection = ""
 
Dim i As Integer
Dim rng As Range
 
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
 
Dim MairieActive As String
 
 
Dim WK As Object
Set WK = New Excel.Application
    WK.Workbooks.Add
    WK.Visible = True
    WK.DisplayAlerts = False
 
    Set rs = CurrentDb.OpenRecordset(sqlFDR & " order by commune desc", dbReadOnly)
 
    'style des etiquettes
    With WK.ActiveWorkbook.Styles.Add(Name:="Etiquettes")
        .Font.Color = vbBlue
        .Interior.Color = RGB(102, 153, 0)
        .Font.Color = vbWhite
    End With
 
 
        With WK.ActiveWorkbook.ActiveSheet
 
            'Feuille de garde
 
            .Name = "Feuille de route"
 
            Set rng = .Range("A1:k1")
            rng.Value = "Feuille de route mairies"
            rng.MergeCells = True
            rng.Style = "Etiquettes"
 
            Set rng = .Range("b3")
            rng.Value = "Commercial : "
 
            Set rng = .Range("c3:g3")
            rng.MergeCells = True
            rng.Value = rs!Commercial
 
  End With
 
      Do While Not rs.EOF
 
    'Renseignement mairie active
    MairieActive = rs!IDMairie
    Debug.Print MairieActive
      Set rs2 = CurrentDb.OpenRecordset("select * from rqevenementsmairies where idmairie='" & MairieActive & "'", dbReadOnly)
 
        WK.ActiveWorkbook.Sheets.Add
 
        With WK.ActiveWorkbook.ActiveSheet
 
        .Name = rs!Commune
 
        Set rng = .Range("a1:h1")
        rng.Value = rs!Mairie
        rng.Style = "Etiquettes"
        rng.MergeCells = True
 
        Set rng = .Range("i1:k1")
        rng.Value = "Tél. : " & Format(rs!TELMAIRIE, "00\.00\.00\.00\.00")
        rng.Style = "Etiquettes"
        rng.MergeCells = True
 
        Set rng = .Range("i3:k3")
        rng.MergeCells = True
        rng.Value = rs!Ligne1Adresse
 
        Set rng = .Range("i4:k4")
        rng.MergeCells = True
        rng.Value = rs!Ligne2Adresse
 
        Set rng = .Range("i5:k5")
        rng.MergeCells = True
        rng.Value = rs!Ligne3Adresse
 
        Set rng = .Range("a3")
        rng.Value = "EPCI : "
        rng.Style = "Etiquettes"
 
        Set rng = .Range("b3:g3")
        rng.MergeCells = True
        rng.Value = rs!EPCI
 
 
        Set rng = .Range("a5")
        rng.Value = "INSEE : "
        rng.Style = "Etiquettes"
 
        Set rng = Range("b5")
        rng.Value = Format(rs!INSEE, "00000")
 
        Set rng = .Range("d5")
        rng.Value = "Commercial : "
        rng.Style = "Etiquettes"
 
        Set rng = .Range("e5:f5")
        rng.MergeCells = True
        rng.Value = rs!Commercial
 
        Set rng = .Range("A7")
        rng.Value = "Etat prospection : "
        rng.Style = "Etiquettes"
 
        Set rng = .Range("b7:g7")
        rng.MergeCells = True
        rng.Value = rs!EtatProspection
 
        Set rng = .Range("a8")
        rng.Value = "Echeance : "
        rng.Style = "Etiquettes"
 
        Set rng = .Range("b8")
        rng.Value = Format(rs!HeureEvt, "hh:nn")
 
        Set rng = .Range("c8:d8")
        rng.MergeCells = True
        rng.Value = Format(rs!DateEcheanceEvt, "ddd dd mmm yyyy")
 
        Set rng = .Range("a10")
        rng.Value = "Maire : "
        rng.Style = "Etiquettes"
 
        Set rng = .Range("b10:c10")
        rng.MergeCells = True
        rng.Value = rs!Maire
 
        Set rng = .Range("d10")
        rng.Value = "Tel. maire : "
        rng.Style = "Etiquettes"
 
        Set rng = .Range("e10")
        rng.Value = Format(rs!TelephoneMaire, "00\.00\.00\.00\.00")
 
        Set rng = .Range("f10")
        rng.Value = "Mobile maire : "
        rng.Style = "Etiquettes"
 
        Set rng = .Range("g10")
        rng.Value = Format(rs!MobileMaire, "00\.00\.00\.00\.00")
 
        'Tableau évènements
        Set rng = .Range("a12:k12")
        rng.MergeCells = True
        rng.Value = "Historique évènements"
        rng.Style = "Etiquettes"
 
        Set rng = .Range("a14")
        rng.Value = "Echéance : "
        rng.Style = "Etiquettes"
 
        Set rng = .Range("b14")
        rng.Value = "Heure : "
        rng.Style = "Etiquettes"
 
        Set rng = .Range("c14:d14")
        rng.MergeCells = True
        rng.Value = "Etat prospection : "
        rng.Style = "Etiquettes"
 
        Set rng = .Range("e14:k14")
        rng.MergeCells = True
        rng.Value = "Commentaires :"
        rng.Style = "Etiquettes"
 
                i = 16
        Do While Not rs2.EOF
 
            Cells(i, 1).Value = Format(rs2!DateEcheanceEvt, "ddd dd mmm yyyy")
            Cells(i, 2).Value = Format(rs2!HeureEvt, "hh:nn")
            WK.ActiveWorkbook.ActiveSheet.Range(Cells(i, 3), Cells(i, 4)).MergeCells = True
            Cells(i, 3).Value = rs2!EtatProspection
 
            WK.ActiveWorkbook.ActiveSheet.Range(Cells(i, 5), Cells(i, 11)).MergeCells = True
            Cells(i, 5).Value = rs2!RemarquesEvt
            'Cells(i, 5).EntireColumn.AutoFit
            Cells(i, 5).RowHeight = 50
                With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
 
        rs2.MoveNext
 
        i = i + 1
 
        Loop
 
    .Columns.AutoFit
 
    End With
 
 
    rs.MoveNext
    Loop
 
 
    WK.DisplayAlerts = True
 
 
 
    rs.Close: Set rs = Nothing
    rs2.Close: Set rs2 = Nothing
 
Set WK = Nothing
Set rng = Nothing
'sqlFDR = ""
 
End Sub

Bonjour,
l'utilisation de ActiveSheet et ActiveWorkbook sont à proscrire.
Voici un exemple de déclaration en Late Binding (ou liaison tardive en français):
Code:

1 2 3 4 5 6 7 8 9 ' Déclaration Late Binding Dim oAppXl As object Dim oWkb As object Dim oWSht As object ' Affectation Set oAppXl = CreateObject("Excel.application") ' Crée un nouvelle instance Excel Set oWkb = oAppXl.Workbooks.Add ' Crée un nouveau classeur Excel Set oWSht = oWkb.Worksheets(1) ' Définit la feuille 1 du classeur
Avantage: on n'a pas besoin de cocher la référence Excel c'est donc portable d'une version Excel à l'autre.
Inconvénient: on perd l'auto-complétion (ou intellisense en anglais), on a donc intérêt à connaitre les méthodes et les propriétés des objets utilisés.

With est utile dans certains cas mais il ne faut surtout pas les imbriquer, donc il vaut mieux utiliser directement le nom de l'objet que l'on a pris soin de bien raccourcir:
Code:

1 2 3 oWkb.Styles.Add(Name:="Etiquettes") oWkb.Font.Color = vbBlue oWkb.Interior.Color = RGB(102, 153, 0)
Tu peux aussi utiliser la déclaration en Early Binding (ou liaison anticipée) pour mettre au point ton code:
Code:

1 2 3 4 5 6 7 8 ' Déclaration Early Binding Dim oAppXl As New Excel.Application Dim oWkb As Excel.Workbook Dim oWsht As Excel.Worksheet ' Affectation Set oWkb = oAppXl.Workbooks.Add ' Crée un nouveau classeur Excel Set oWSht = oWkb.Worksheets(1) ' Définit la feuille 1 du classeur
et lorsqu'il est terminé et bien au point, tu remplaces les instructions de déclaration et éventuellement d'affectation par celles du Late Binding.
Autre méthode de déclaration en Early Binding:
Code:

1 2 3 4 5 ' Déclaration Dim oAppXl As Excel.Application ' Affectation Set oAppXl = New Excel.Application

Je te remercie énormément pour ta réponse tutoriel qui va m'être très utile car j'avais besoin de connaitre les bonnes pratiques... :)