Discussion :

[totor92290]

Bonsoir,

Je recherche sur les forums et puis rien...

J'éssaie désespérément de touver les lignes de codes pour lancer via Access plusieurs documents excel et dans le dernier lancer une macro Excel.

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
Private Sub Commande0_Click()
 
Dim appExcel As Object
 
    Set appExcel = CreateObject("Excel.Application")
 
        appExcel.Visible = True
        appExcel.DisplayAlerts = True
 
        With appExcel
 
 
            .Workbooks.Open ("C:\PERSO\carte grise.xls")
            .Run ("convert_csv.xls!Macro1")
 
        End With
 
        appExcel.DisplayAlerts = False
        appExcel.Quit
 
    Set appExcel = Nothing
 
 
 
 
    Set appExcel = CreateObject("Excel.Application")
 
        appExcel.Visible = True
        appExcel.DisplayAlerts = True
 
        With appExcel
 
 
            .Workbooks.Open ("C:\PERSO\Classeur1.xls")
            .Run ("convert_csv.xls!Macro1")
 
        End With
 
        appExcel.DisplayAlerts = False
        appExcel.Quit
 
    Set appExcel = Nothing
 
End Sub

Si quelqu'un peut m'aider ?

[helas]

Bonjour,
pourquoi refermer Excel ?

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
 
    Dim appExcel As Object
 
    Set appExcel = CreateObject("Excel.Application")
    appExcel.Visible = True
    appExcel.DisplayAlerts = True
 
    With appExcel
         .Workbooks.Open ("C:\PERSO\carte grise.xls")
         .Run ("convert_csv.xls!Macro1")
         .Workbooks("carte grise.xls").Close
 
         .Workbooks.Open ("C:\PERSO\Classeur1.xls")
         .Run ("convert_csv.xls!Macro1")
         .Workbooks("classeur1.xls").Close
 
   End With
 
  appExcel.DisplayAlerts = False
  appExcel.Quit
  Set appExcel = Nothing

[totor92290]

Bonsoir,

En fait j'importe des données de sap sous excel et parfois des contenu de cellules sont à retravailler.
1 - j'extrait les données et je fais enregistrer / remplacer
2 - je clic sous access sur un bouton qui lance le code ci-dessous (enfin à peu près !) qui théoriquement ouvre le 1er fichier excel, ouvre le second et lance la macro mise en forme, ferme excel et ajoute, en fichier joint vers une base archive en requete ajout access

Ma problématique c'est lancer deux fichiers excel.

[Godzestla]

Bonjour,

j'ai du code pour faire cela, j''spère que cela pourra t'aider.

Mon but est un peu différent du tien, quoi que.

Le principe :
1) J'exporte d'access vers Excel des tables et ou requêtes
2) Si l'SQL (ou la table) est lié à un code de remise en forme (formattage) de cet export (via une table dans access qui me dit si mon export est à reformatter), je passe à l'étape 3, sinon mon export est terminé
3) J'ouvre un fichier excel qui contient tous les script de reformattage.
4) J'exécute le script de reformattage voulu, et celui-ci prend un charge la manipulation complète du fichier cible depuis l'ouverture jusqu'à sa fermeture. (possibilité de passer des variables pour par exemple renommer les colonnes, faire des sélection dynamiques, ...)

Voici le code que j'espère complet : (J'ai mis un exemple où je passe des paramêtres variables à Excel (Specific_Parm)

1) Access :
Code bouton

Code :

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

1
2
3
4
5
Private Sub Command161_Click()
 
specific_parm = " " & "~" & Trim(get_Weeks_Nbr)
Export_Excelsheet "SQL_Export_Workshops", "Mandatory Workshops", specific_parm
End Sub

Code du module qui gère les exports
A) Export en tant que tel vers folder et avec nom géré par application

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
Public Sub Export_Excelsheet(From_Table As String, to_file As String, Specific_param As Variant)
    Dim recv     As Recordset
    Dim Reci     As Recordset
    Dim Recexcel As Recordset
    Dim Argument As String
    Dim Quote    As String
    Dim nada     As Variant
    Dim Res      As Variant
 
 
    Dim Dbv  As Database
    Dim document As String
    Dim Excel_Workbook As String
 
 
    Quote = """"
    'Reference Current Database
 
    Set Dbv = DBEngine.Workspaces(0).Databases(0)
 
    'Open Recordset Zcontrol and get 1st record
 
    Set recv = Dbv.OpenRecordset("SQL_Zcontrol", , dbReadOnly)
    recv.FindFirst "DB_Year > 0"
 
    If recv.EOF Then GoTo exit_export_excelsheet
 
    'Open Recordset Installations  and get 1st record
 
    Set Reci = Dbv.OpenRecordset("SQL_Installation_Lines", , dbReadOnly)
    Reci.FindFirst "Install_Nr > 0"
 
    If Reci.NoMatch Then GoTo exit_export_excelsheet
 
    document = Trim(recv![Generated_excel_Folder]) & Format(Now, "yyyy-mm-dd") & "_" & Trim(to_file) & ".Xls"
    Excel_Workbook = recv![Generated_File_Prefix] & Format(Now, "yyyy-mm-dd") & "_" & Trim(to_file) & ".Xls"
 
    Res = Dir(document, vbNormal)
    If Res <> "" Then
    'On Error Resume Next
        Kill document
    End If
 
 
    'Export
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, From_Table, document, True
 
 
    'Open Recordset Export_Excel  and get 1st record
 
    Set Recexcel = Dbv.OpenRecordset("SQL_Export_Excel", dbOpenDynaset, dbReadOnly)
    Argument = "Object_Name = '" & From_Table & "'"
    Recexcel.FindFirst Argument
 
    If Recexcel.NoMatch Then
       MsgBox to_file & " exported to " & Trim(recv![Generated_excel_Folder]) & Format(Now, "yyyy-mm-dd") & "_" & Trim(to_file) & ".Xls"
       GoTo exit_export_excelsheet
    End If
    MsgBox to_file & " exported to " & Trim(recv![Generated_excel_Folder]) & Format(Now, "yyyy-mm-dd") & "_" & Trim(to_file) & ".Xls (Script File '" & Trim(recv![Excel_Script_File]) & "[" & Trim(Recexcel![Script_Name]) & "]' will be applied now)"
    'Apply Formatting Excel Script
    Call Execute_Excel_Script(document, Excel_Workbook, recv![Script_Folder], recv![Excel_Script_File], Recexcel![Script_Name], Specific_param)
    Recexcel.Close
    recv.Close
    Reci.Close
 
    Set Recexcel = Nothing
    Set recv = Nothing
    Set Reci = Nothing
 
exit_export_excelsheet: '
End Sub

B) Si l'objet exporté est lié à un script, on est parti pour le reformattage.
Dans l'exemple donné, l'SQL exporté est lié au Script excel Gmain_Mandatory_Workshops (info trouvée dans SQL_Export_Excel)

Pour info, le nom du fichier Excel qui contient tous les scripts est dans une table de ma DB.


Code Access d'appel du script de reformattage.

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
Sub Execute_Excel_Script(document As String, Excel_Workbook As String, Script_Folder As String, Excel_Script_File As String, Script_Name As String, Specific_param As Variant)
On Error Resume Next
Dim xlapp As Object
Dim ExcelWasNotRunning As Boolean    ' Indicateur de libération finale.
Dim FullScript As String
 
FullScript = Trim(Script_Folder) & Trim(Excel_Script_File)
 
Set xlapp = GetObject(, "Excel.Application")
If err <> 0 Then
   err.Clear
   ExcelWasNotRunning = True
   Set xlapp = CreateObject("Excel.application")
 Else
    ExcelWasNotRunning = False
End If
xlapp.Visible = True
Set XlWkb = xlapp.Workbooks.Open(FullScript)
 '
 ' ici nous lançons les macros automatiques d'Excel mais vous pouvez mettre du code
 '
XlWkb.RunAutoMacros xlAutoOpen
 
xlapp.Run Script_Name, document, Excel_Workbook, Excel_Script_File, Specific_param
'XlWkb.Save
XlWkb.Close
If ExcelWasNotRunning = True Then  'Reactivé 16/12/2010
    xlapp.Application.Quit
End If
 
Set XlWkb = Nothing
Set xlapp = Nothing
 
 
End Sub

2) Excel :
Script de reformattage pour cet export précis (mais les paramètre sont toujours identiques). Ce code n'est pas très optimisé, mais tu as une idée des possibilités ainsi.

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
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
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
Sub Gmain_Mandatory_workshops(Document As String, Excel_Workbook As String, Excel_Script_File As String, Specific_param As Variant)
 
'
' Gmain_Student_List Macro
' Macro enregistrée le 26/05/2006 par Admin
'
    Dim lrow        As Long
    Dim xlrow       As String
    Dim Range_Id    As String
    Dim Temp_Range_Id As String
    Dim off        As Long
    Dim Column_from As String
    Dim Column_to   As String
    Dim Start_Range_Id As String
    Dim tablw()      As String
    Dim weeks        As Single
    Dim IDx          As Integer
    Dim To_line      As Long
    Dim From_line    As Long
    Dim Sel_Range    As String
    Dim Current_Sheet As String
 
 
    Workbooks.Open Filename:=Document
 
    Windows(Excel_Workbook).Activate
    ActiveSheet.UsedRange
    ActiveSheet.UsedRange
    Range_Id = Get_Range_Id(ActiveSheet.UsedRange.Name)
    Start_Range_Id = Range_Id
    Column_from = Trim(Get_Column_From(ActiveSheet.UsedRange.Name))
    Column_to = Trim(Get_Column_To(ActiveSheet.UsedRange.Name))
    Range(Range_Id).Select
'**********************************************
'* real VB Script Start  here                 *
'**********************************************
'Header Line In Bold
    Range_Id = Column_from & "1:" & Column_to & "1"
    Range(Range_Id).Font.Bold = True
    lrow = ActiveSheet.UsedRange.Rows.Count
    xlrow = lrow
'Save Current Sheet name
    Current_Sheet = ActiveSheet.Name
 
'Autofit
    Range_Id = Column_from & ":" & Column_to
    Columns(Range_Id).EntireColumn.AutoFit
 
'get Specific parms : Nbr of weeks
    tablw = Split(Specific_param, "~") 'Specific param = Weeks_nbr
    weeks = tablw(1)
 'Rename Mandatory Workshop A Choice Weeks Colums Header
    Sel_Range = "D1"
    For IDx = 1 To weeks
    With Range(Sel_Range).Offset(0, IDx - 1)
            .Value = "Week" & IDx & " A"
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
     End With
   Next IDx
 
'Resize Renamed Column
    Range_Id = "D:K"
    Columns(Range_Id).ColumnWidth = 15
 
 'unused Week : Counter (From C))
   For IDx = weeks + 1 To 8
    Columns(Range("C1").Column + IDx).EntireColumn.Hidden = True
   Next IDx
 
'Rename Mandatory Workshop B Choice Weeks Colums Header
    Sel_Range = "L1"
    For IDx = 1 To weeks
    With Range(Sel_Range).Offset(0, IDx - 1)
            .Value = "Week" & IDx & " B"
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
     End With
   Next IDx
 
'Resize Renamed Column
    Range_Id = "L:T"
    Columns(Range_Id).ColumnWidth = 15
 
 'unused Week : Counter (From K))
   For IDx = weeks + 1 To 8
    Columns(Range("K1").Column + IDx).EntireColumn.Hidden = True
   Next IDx
 
 
'Add Border Line to delimit NAme
    Range_Id = "B2:B" & xlrow
    Range(Range_Id).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
'Restrict Width
    Columns("A:A").Select 'Category
    Selection.ColumnWidth = 7
    Columns("B:B").Select 'Name
    Selection.ColumnWidth = 30
    Columns("C:C").Select 'Age
    Selection.ColumnWidth = 4.57
 
 
'Sort
    Range(Start_Range_Id).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
 
'Add 1 line at top for header
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    With Range("D1")
         .FormulaR1C1 = "WORKSHOPS A"
         .Font.Bold = True
    End With
    With Range("D1:E1")
            .MergeCells = True
    End With
    With Range("L1")
         .FormulaR1C1 = "WORKSHOPS B"
         .Font.Bold = True
    End With
    With Range("L1:M1")
            .MergeCells = True
    End With
 
'Add Border Line to delimit Workshops Group A & B
    Range_Id = "D2:D" & xlrow + 1
    Range(Range_Id).Select
    With Range(Range_Id)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
    End With
    Range_Id = "L2:L" & xlrow + 1
    Range(Range_Id).Select
    With Range(Range_Id)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
    End With
    Range_Id = "T2:T" & xlrow + 1
    Range(Range_Id).Select
    With Range(Range_Id)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
    End With
 
 
 
 
 
'Freeze panes
    Range("B3").Select
    ActiveWindow.FreezePanes = True
 
'Add Details sheet for Pivot source
    Sheets.Add
    ActiveSheet.Name = "Details"
 
'Build Details For Pivot Summarization
    Worksheets("SQL_Export_Workshops").Range("A2:C2").Copy _
        Destination:=Worksheets("Details").Range("A1")
    Worksheets("Details").Range("D1") = "Workshop A"
    Worksheets("Details").Range("E1") = "Workshop B"
    Worksheets("Details").Range("F1") = "Student"
    Worksheets("Details").Range("G1") = "Weeks"
    Sheets("Details").Range("D1:G1").Font.Bold = True
 
    To_line = 2
    For From_line = 3 To lrow + 1
        For IDx = 1 To weeks
            Worksheets("Details").Range("A" & To_line) = Worksheets("SQL_Export_Workshops").Range("A" & From_line)
            Worksheets("Details").Range("B" & To_line) = Worksheets("SQL_Export_Workshops").Range("B" & From_line)
            Worksheets("Details").Range("C" & To_line) = Worksheets("SQL_Export_Workshops").Range("C" & From_line)
            'Workshop A
            Worksheets("Details").Range("D" & To_line) = Worksheets("SQL_Export_Workshops").Range("D" & From_line).Offset(0, IDx - 1)
            'Workshop B
            Worksheets("Details").Range("E" & To_line) = Worksheets("SQL_Export_Workshops").Range("L" & From_line).Offset(0, IDx - 1)
            'Student Count = 1
            Worksheets("Details").Range("F" & To_line) = 1
            'Week Number
            Worksheets("Details").Range("G" & To_line) = "Week " & IDx
            To_line = To_line + 1
        Next IDx
    Next From_line
 
 
    Sheets("Details").Select
    Columns("A:F").EntireColumn.AutoFit
'Restrict Width
    Columns("A:A").Select 'Category
    Selection.ColumnWidth = 7
    Columns("B:B").Select 'Name
    Selection.ColumnWidth = 30
    Columns("C:C").Select 'Age
    Selection.ColumnWidth = 4.57
 
'Add Border Line to delimit NAme
    Range_Id = "B2:B" & To_line - 1
    Range(Range_Id).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
'Freeze panes
    Range("B2").Select
    ActiveWindow.FreezePanes = True
 
 
 'Build Pivot Table Workshop A
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Details!R1C1:R" & To_line - 1 & "C7").CreatePivotTable TableDestination:="", TableName:= _
        "WorkshopA", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    With ActiveSheet.PivotTables("WorkshopA").PivotFields("Junior/Senior")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("WorkshopA").PivotFields("Weeks")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("WorkshopA").PivotFields("Workshop A")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("WorkshopA").AddDataField ActiveSheet.PivotTables( _
        "WorkshopA").PivotFields("Student"), "Sum of Student", xlSum
    ActiveSheet.Name = "Workshop A"
 
    Sheets("Details").Select
 'Build Pivot Table Workshop B
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Details!R1C1:R" & To_line - 1 & "C7").CreatePivotTable TableDestination:="", TableName:= _
        "WorkshopB", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    With ActiveSheet.PivotTables("WorkshopB").PivotFields("Junior/Senior")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("WorkshopB").PivotFields("Weeks")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("WorkshopB").PivotFields("Workshop B")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("WorkshopB").AddDataField ActiveSheet.PivotTables( _
        "WorkshopB").PivotFields("Student"), "Sum of Student", xlSum
    ActiveSheet.Name = "Workshop B"
 
    Application.CommandBars("PivotTable").Visible = False
 
 
 
    'Sheets("SQL_Export_Workshops").Select
 
    Sheets(Current_Sheet).Select
 
 
'goto A1
    Range("A1").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
'**********************************************
'* real VB Script Stop   here                 *
'**********************************************
    Windows(Excel_Script_File).Activate
    'Windows(tutu).Activate
End Sub

Désolé pour la longueur. Pas facile de résumer.

[totor92290]

Merci Godzestla,
En fait je me suis mal exprimé.

Ce que je voudrais savoir c'est si il est possible de lancer, en cliquant sur un bouton dans access, deux fichier excel et si possible séléctionner un onglet précis dans le fichier.
quand je fait le code 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
Private Sub Commande0_Click()
 
Dim appExcel As Object
 
    Set appExcel = CreateObject("Excel.Application")
 
        appExcel.Visible = True
        appExcel.DisplayAlerts = True
 
        With appExcel
 
 
            .Workbooks.Open ("C:\PERSO\carte grise.xls")
            .Run ("convert_csv.xls!Macro1")
 
        End With
 
        appExcel.DisplayAlerts = False
        appExcel.Quit
 
    Set appExcel = Nothing
 
 
 
 
End Sub

je ne peux en ouvrir qu'un seul fichier excel.

[Godzestla]

Bonjour,

je ne peux en ouvrir qu'un seul fichier excel.

Ben non.

Ici tu peux ouvrir et traiter plusieurs fichiers excel

Code :

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

1
2
3
4
5
6
7
        With appExcel
  
 
            .Workbooks.Open ("C:\PERSO\carte grise.xls")
            .Run ("convert_csv.xls!Macro1")
  
        End With

Mais, je pense qu'il faudrait rajouter le close (et le save) du clessseur avant le quit.