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
| Sub test()
On Error Resume Next
Kill ThisWorkbook.Path & "\test_vbs\*.*" 'pour détruire tous les fichiers excel présents dans test_vbs
RmDir ThisWorkbook.Path & "\test_vbs"
MkDir ThisWorkbook.Path & "\test_vbs"
Err.Clear
On Error GoTo 0
vbssession2
requetevbs = ThisWorkbook.Path & "\sessionsvbs.vbs"
SC = """" & requetevbs & """ "
For j = 0 To 20 'pour lancer une boucle sur 0 à 20 vbscripts
elmnt = "test" & j
reper = ThisWorkbook.Path & "\test_vbs"
flnc = reper & "\" & elmnt & ".xlsx"
Set WS = CreateObject("WScript.Shell") 'pour créer le VBScript
WS.Run SC & j & " " & flnc 'pour lancer le Vbscript avec les 2 arguments j et flnc
Next j
End Sub
Sub vbssession2() 'création du code vbs pour lancer les 2° session excel
Dim code As String, FSys As Object, MonFic As Object
code = code & "Dim Excel2, wb2, sh2, Graph2" & vbCrLf
code = code & "Set Excel2 = CreateObject(""Excel.Application"")" & vbCrLf
code = code & "Set wb2 = Excel2.Workbooks.Add" & vbCrLf
'ici le := de Before non compris par VBScript
'code = code & "wb2.Sheets.Add (Before:=wb2.Sheets(""Feuil1"")).Name = ""Test""" & vbCrLf 'ne marche pas
code = code & "wb2.Sheets.Add.Name = ""Test""" & vbCrLf 'par chance la nouvelle feuille excel se créé en 1° place
code = code & "Set sh2 = wb2.Sheets(1)" & vbCrLf
code = code & "With sh2" & vbCrLf
code = code & " .Cells(1, 2).Value = ""Nombre""" & vbCrLf
code = code & " .Cells(1, 3).Value = ""Date""" & vbCrLf
code = code & " For i = 0 To 20" & vbCrLf
code = code & " .Cells(i + 2, 2).Value = i" & vbCrLf
code = code & " .Cells(i + 2, 3).Value = (WScript.Arguments(0)+1) * i" & vbCrLf
code = code & " Next" & vbCrLf
code = code & "End With" & vbCrLf
code = code & "sh2.Cells(1, ""M"").Select" & vbCrLf
code = code & "Set Graph2 = wb2.Charts.Add" & vbCrLf
code = code & "wb2.Windows(1).Zoom = 100" & vbCrLf
'code = code & "wb2.ActiveChart.ChartType = xlXYScatterLines" & vbCrLf 'le xlXYScatterlines non compris par Vbscript
code = code & "wb2.ActiveChart.Name = ""Graph1""" & vbCrLf
code = code & "wb2.ActiveChart.SeriesCollection.NewSeries" & vbCrLf
code = code & "wb2.ActiveChart.SeriesCollection(1).Formula = ""=SERIES('Test'!C1,'Test'!B2:B"" & 22 & "" ,'Test'!C2:C"" & 22 & "",1)""" & vbCrLf
code = code & "wb2.ActiveChart.HasTitle = True" & vbCrLf
code = code & "wb2.ActiveChart.ChartTitle.Text = ""Test de graphique""" & vbCrLf
code = code & "wb2.ActiveChart.ChartTitle.Font.Size = 8" & vbCrLf
code = code & "Excel2.Application.DisplayAlerts = False" & vbCrLf
code = code & "wb2.SaveAs WScript.Arguments(1)" & vbCrLf 'ok marche avec sauvegarde au format défini par WScript.Arguments(1) le FileFormat := lui non compris
code = code & "wb2.Close" & vbCrLf
code = code & "Excel2.Application.DisplayAlerts = True" & vbCrLf
code = code & "Set wb2 = Nothing" & vbCrLf
code = code & "Set sh2 = Nothing" & vbCrLf
code = code & "Set Graph2 = Nothing" & vbCrLf
code = code & "Set Excel2 = Nothing" & vbCrLf
With ThisWorkbook
Set FSys = CreateObject("Scripting.FileSystemObject")
Set MonFic = FSys.CreateTextFile(.Path & "\sessionsvbs" & ".vbs")
With MonFic
.write code
End With
End With
End Sub |
Partager