Discussion :

[nonik]

Bonjour,

Tout d'abord je suis totalement débutant dans le vbs mais dans le cadre de mon travail, je dois automatiser une tache : créer un histogramme 2D via une macro ( ou autre ) dans plusieurs fichiers Excel qui changeront tous les mois ( généré par un automate ).
Alors :
- ma macro Excel fonctionne dans un fichier test et est adaptable à tout fichier de l'automate donc c'est ok.
Par contre, apres pleins de recherches, je n'arrive pas à coder le script vbs qui automatisera cette tache.
Voici le code que j'ai pour le moment, mais avec erreurs d'execution ( que je n'arrive pas à résoudre ) :

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
 
 Sub ProcessFiles()
 Dim Filename As String
 Dim Pathname As String
 Dim wb As Workbook
 
 Pathname = ActiveWorkbook.Path & "\\c:\toto\"
 Filename = Dir(Pathname & "*.xls")
 Do While Filename <> ""
 Set wb = Workbooks.Open(Pathname & Filename)
 DoWork wb
 wb.Close SaveChanges:=True
 Filename = Dir()
 Loop
 End Sub
 
 Sub DoWork(wb As Workbook)
 With wb
 //MA MACRO ICI
 End Sub

Merci par avance !

Nonik

EDIT : j'ai cru comprendre qu'en VBS on ne déclarait pas avec "as" mais même sans cela j'ai des erreurs d'execution.... Merci !

[l_autodidacte]

Si le script est codé et exécuté sous Excel, on peut(plus exactement on doit) typer les variables tout en ajoutant une référence à FileSystemObject(Microsoft Scripting Runtime depuis le fichier Scrrun.dll dans le répertoire système)

S'il s'agit d'un fichier script(.vbs) à part, ON NE DOIT PAS TYPER LES VARIABLES.

A quel niveau du code se produit l'erreur(Ligne et caractère de début puis code d'erreur) ?

[nonik]

Il s'agit d'un fichier .vbs a part ( executer hors Excel ).
Les erreurs se produisent "Lign 2 - Erreur de compilation ". Si j'enleve les déclaration ( as string etc.. ) l'erreur se produit "Ligne 11 - Erreur de compilation VBScript".
La ligne 11 correspond à :

Code :

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

wb.Close SaveChanges:=True

Ne connaissant pas grand chose, je ne sais pas d'où vient l'erreur.

Merci !

[nonik]

Apres quelques modifications du script ( j'ai enlevé les déclarations et remplacé les":=" par des "=" ) le scripts ne génère plus d'erreurs.
Par contre il ne fonctionne pas.
Voici le code actuel :

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
Sub ProcessFiles()
    Dim Filename 
    Dim Pathname 
    Dim wb 
 
    Pathname = ActiveWorkbook.Path & "\c:\toto\"
    Filename = Dir(Pathname & "*.xls")
    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        DoWork wb
        wb.Close SaveChanges=True
        Filename = Dir()
    Loop
End Sub
 
Sub DoWork(wb)
    With wb
        Range("a16").Select
			Selection.CurrentRegion.Select
			myrange = Selection.Address
			mysheetname = ActiveSheet.Name
			ActiveSheet.ChartObjects.Add(300, 250, 600, 400).Select
			Application.CutCopyMode = False
			ActiveChart.ChartWizard _
			Source=Sheets(mysheetname).Range(myrange), _
			Gallery=xlColumnStacked, Format=4, PlotBy=xlColumns, _
			CategoryLabels=1, SeriesLabels=1, HasLegend=1, _
			Title="", CategoryTitle="", _
			ValueTitle="", ExtraTitle=""
 
    End With
End Sub

Merci de votre aide

[l_autodidacte]

Remplace cette ligne wb.Close SaveChanges:=True par wb.Close True sans 'SaveChanges:='

[nonik]

J'ai fait la modification mais toujours rien.
Quand je clique sur le fichier .vbs, rien ne se passe. Quand je vérifie dans le fichier excel, la macro n'a pas été exécutée.
Ci-dessous le script en entier :

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
Sub ProcessFiles()
    Dim Filename 
    Dim Pathname 
    Dim wb 
 
    Pathname = ActiveWorkbook.Path & "\c:\toto\"
    Filename = Dir(Pathname & "*.xls")
    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        DoWork wb
        wb.Close True
        Filename = Dir()
    Loop
End Sub
 
Sub DoWork(wb)
    With wb
        Range("a16").Select
			Selection.CurrentRegion.Select
			myrange = Selection.Address
			mysheetname = ActiveSheet.Name
			ActiveSheet.ChartObjects.Add(300, 250, 600, 400).Select
			Application.CutCopyMode = False
			ActiveChart.ChartWizard _
			Source=Sheets(mysheetname).Range(myrange), _
			Gallery=xlColumnStacked, Format=4, PlotBy=xlColumns, _
			CategoryLabels=1, SeriesLabels=1, HasLegend=1, _
			Title="", CategoryTitle="", _
			ValueTitle="", ExtraTitle=""
 
    End With
End Sub

Je ne suis pas sur de : Pathname = ActiveWorkbook.Path & "\c:\toto\" la syntaxe du chemin mais j'ai essayé avec \c:\toto\ et c:\toto mais pareil, rien ne se passe.
Je précise que dans c:\toto j'ai mis un fichier excel de l'automate pour faire un test, le chemin réel est réseau.
Merci pour votre aide

[l_autodidacte]

Code :

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

Pathname = ActiveWorkbook.Path & "\c:\toto\"

Une première remarque est que ce chemin n'est pas valide car il contiendrait au début la racine d'un lecteur + celle ajoutée (\c:\toto\).

Une seconde est que les variables objet telles que Application, wb, myrange .... doivent être déclarées puis implémentées avec Set.

Pour cette raison, j'ai toujours conseillé d'utiliser la clause Option Explicit permettant de voir si une variable n'a pas été déclarée et le cas échéant implémentée.
Pour garder le code tel qu'il est, on peut faire par exemple :

Code :

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

1
2
3
Dim Application, wb
Set Application = CreateObject("Excel.Application")
Set wb = Application.Workbooks.Open(Pathname & Filename)

Pathname devra être explicitement défini (ex : Pathname = "C:\toto\")

La fonction Dir n'est reconnue par Wscript(ou VbScript). Il faut recourir à FileSystemObject. Une petite esquisse est ce

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
Sub ExecMacro()
  Dim fso, F, wb, oFold, Application, sPath
  Set fso = CreateObject("Scripting.FileSystemObject") 
  sPath = "C:" 'Application.ActiveWorkbook.Path '& "\toto\"
  If Right(spath, 1) <> "\" Then sPath = sPath & "\"
   Set oFold = fso.GetFolder(sPath)
   Set Application = CreateObject("Excel.Application")
   For Each F In oFold.Files 
       If Ucase(Right(F.Name, 4)) = ".XLS" Then 
          Set wb = Application.Workbooks.Open(F.Path)
          DoWork wb
          wb.Close True
       End If
   Next
End Sub