lancer un batch à partir d'une macro

[bonjourdoc]

Salut,

J'ai créé une macro sur excel 2010 me permettant de compiler plein de fichiers .xls en un seul, pour faire des statistiques.

On m'a aidé à créer un batch qui me permet de copier mes fichiers .xls vers des autres dossiers.

Voici le code:
Code:

@Echo off
Copy "*.xls" "C:\Users\pret\Desktop\Pre_reservations\BE"
Copy "*.xls" "C:\Users\pret\Desktop\Pre_reservations\NE"
del C:\Users\pret\Desktop\Pre_reservations\BE\global_prereservation_JU.xls
del C:\Users\pret\Desktop\Pre_reservations\NE\global_prereservation_JU.xls
Echo Le(s) fichier(s) xls a/ont bien ete copies !
Ping localhost -n 3 > nul


Ma macro s'exécute parfaitement. Puis je lance mon batch copie.bat manuellement; il s'exécute normalement aussi.

J'aimerais que ma macro lance copie.bat automatiquement.

J'utilise la ligne de commande VBA suivante:
Code:

Call Shell("C:\Users\pret\Desktop\Pre_reservations\copie.bat")


Le batch se lance, mais il ne s'exécute pas comme si je le lançais manuellement!
Résultat:


*.xls
Le fichier spécifié est introuvable.


Je ne comprends pas pourquoi mon copie.bat ne se lance pas correctement à partir de ma macro.

HELP!

 

[bruno66]

Re : lancer un batch à partir d'une macro

bonjour, il serait bien que tu mettes ton code avec la balise prevu a cette fffe touche # dans le mode avancé

merci d'avance

 

[bonjourdoc]

Re : lancer un batch à partir d'une macro

Yop!

Voici le code batch:

@Echo off
Copy "*.xls" "C:\Users\pret\Desktop\Pre_reservations\BE"
Copy "*.xls" "C:\Users\pret\Desktop\Pre_reservations\NE"
del C:\Users\pret\Desktop\Pre_reservations\BE\global_p rereservation_JU.xls
del C:\Users\pret\Desktop\Pre_reservations\NE\global_p rereservation_JU.xls
Echo Le(s) fichier(s) xls a/ont bien ete copies !
Ping localhost -n 3 > nul

...et voilà le code VBA:

Private Sub Workbook_Open()
 Dim chemin As String ' classeur regroupé
 Dim rep As String ' répertoire à traiter
 Dim fic As String ' classeur regroupé
 Dim ligne As Long ' ligne écriture
 Dim nbc As Integer ' nombre de classeurs
 Dim nbf As Integer ' nombre de feuilles
 Dim nbl As Integer ' nombre de lignes
 Dim mxc As Long ' maximum colones feuille
 Dim c As Integer ' nombre de colonnes
 Dim l As Long ' ligne lecture
 Dim Wf As Worksheet ' feuille regroupement
 Dim Wl As Worksheet ' feuille regroupée
 rep = ThisWorkbook.Path & "\"
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.DisplayAlerts = False
 On Error GoTo fin
 mxc = Cells(1, ActiveSheet.UsedRange.Columns.Count).End(xlToRight).Column
 Set Wf = ThisWorkbook.Sheets("Feuil1") ' variable feuille groupe
 Wf.Cells.ClearContents
 nbc = 0: nbf = 0 ' initialisation variables
 ligne = 1
 fic = Dir(rep & "*.xls") ' recherche fichiers
 While fic <> ""
 If fic <> ThisWorkbook.Name Then
 chemin = rep & fic ' chemin fichiers
 Workbooks.Open chemin, 0 ' ouverture
 Set Wl = ActiveWorkbook.Sheets("JU HEP BEJUNE - Médiathèque de ")
 nbl = Wl.UsedRange.Rows.Count
 c = Wl.UsedRange.Columns.Count
 If ligne > 2 Then l = 2 Else l = 1 ' une seule fois le titre
 Wl.Cells(l, 1).Resize(nbl, c).Copy Destination:=Wf.Cells(ligne, 1)
 ligne = ligne + nbl - l + 1
 nbf = nbf + 1
 ActiveWorkbook.Close SaveChanges:=False ' Fermeture du classeur
 nbc = nbc + 1
 End If
 fic = Dir
 Wend
 For l = ligne To 2 Step -1
 If Wf.Cells(l, mxc).End(xlToLeft).Column = 1 _
 And Wf.Cells(l, 1).Value = "" Then
 Wf.Rows(l).Delete
 ligne = ligne - 1
 End If
 Next l
fin:
 MsgBox nbc & " classeurs regroupés avec " & nbf & " feuilles et " & ligne & " lignes"
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Application.DisplayAlerts = True
 
 ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
     ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("A2"), _
         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     x = ActiveWorkbook.Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
     With ActiveWorkbook.Worksheets("Feuil1").Sort
         .SetRange Range("A2:P" & x)
         .Header = xlNo
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
     ActiveSheet.Range("$A$1:$P$" & x).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, _
         7, 8, 9, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes
 
Call Shell("C:\Users\pret\Desktop\Pre_reservations\copie.bat")
End Sub