Eclater un fichier Excel

[sander59]

Bonsoir ,

Je souhaite éclater un fichier Excel en VBS , voici ce que j'ai tapé :

Sub eclateur_fichier_excel ()

' ce programme doit eclater un fichier excel en plusieurs via un VBScript exterieur
' le fichier xls de depart est zippé et ne peut pas contenir l'eclateur VBA

dim feuille1, feuille2 , feuille3 , feuille4 'as worksheet 4 feuilles au depart
dim classeur1, classeur2 , classeur3 'as workbook  3 classeurs excel au depart
dim chemin1 , chemin2 , chemin3 'as string  3 chemins pour 3 classeurs excel au depart

chemin1 = "D:\test.xls" ' chemin fichier 1
chemin2 = "D:\test2.xls" ' chemin fichier 2
chemin3 = "D:\test3.xls" ' chemin fichier 3

Workbook(array(feuille1,feuille2,feuille3,feuille4))=classeur1 ' contenu classeur 1
Workbook.copy(array(feuille1))=classeur2 ' copie de la feuille 1 du classeur 1 dans le classeur 2
Workbook(array(feuille1))=classeur2 ' nouveau contenu de classeur 2
Workbook.copy(array(feuille2))=classeur3 ' copie de la feuille 2 du classeur 1 dans le classeur 3
Workbook.copy(array(feuille3))=classeur3 ' copie de la feuille 3 du classeur 1 dans le classeur 3
Workbook(array(feuille2,feuille3))=classeur3 ' nouveau contenu de classeur 3

end sud

Je n'arrive pas à faire fonctionner ce code , merci de m'aiguiller 🙂

 

[Staple1600]

Re : Eclater un fichier Excel

Bonsoir à tous

sander59
Le code qu'on lit dans ton message s'apparente à du VBA (avec des erreurs de syntaxe) pas un script VBS.

Voici ci-dessous un exemple de script VBS

'Exemple Script VBS pilotant EXCEL
Set objXLS = CreateObject("Excel.Application")
objXLS.Visible = True
objXLS.Workbooks.Add
objXLS.Sheets(1).Cells(1, 1).Value = "TEST"

(à tester en le copiant dans le bloc-notes et en engistrant sous (sur le Bureau par exemple) en testXL.vbs puis en double-cliquant sur ce fichier)

 

[sander59]

Re : Eclater un fichier Excel

Bonsoir ,

Voici ce que je viens de testé 😀 :

Set objXLS = ExistObject("Excel.Application")
objXLS.Workbooks = "C:\mondossier\Fichier_A"
objXLS.Sheets(1).Cells(A1:AZ12000)
objXLS.Sheets(2).Cells(A1:AZ12000)
objXLS.Sheets(3).Cells(A1:AZ12000)
objXLS.Sheets(4).Cells(A1:AZ12000)

Set objXLS = CREATEObject("Excel.Application")
objXLS.Workbooks = "C:\mondossier\Fichier_B"
objXLS.Workbooks.Add
objXLS.Sheets(1).Cells(A1:AZ12000)

Set objXLS = CREATEObject("Excel.Application")
objXLS.Workbooks = "C:\mondossier\Fichier_C"
objXLS.Workbooks.Add
objXLS.Sheets(2).Cells(A1:AZ12000)

Set objXLS = CREATEObject("Excel.Application")
objXLS.Workbooks = "C:\mondossier\Fichier_D"
objXLS.Workbooks.Add
objXLS.Sheets(3).Cells(A1:AZ12000)
objXLS.Sheets(4).Cells(A1:AZ12000)

Problème ceci ne fonctionne qu'à moitier . J'ai une erreur à la ligne 26 😕

Merci de m'aiguiller

 

[Staple1600]

Re : Eclater un fichier Excel

Re

sander59
Je vois pas pas ce que tu cherches à faire, ni pourquoi tu veux le faire en VBS.
Pour mémoire, Excel utilise le VBA.
(Visual Basic for Application)

NB: La fin d'une procédure, c'est End Sub pas End Sud (voir le code dans ton premier message)

 

[job75]

Re : Eclater un fichier Excel

Bonjour sander59, JM,

Classiquement en VBA on aurait ceci :

Sub eclateur_fichier_excel()
Dim chemin1$, chemin2$, chemin3$, wb As Workbook
chemin1 = "D:\test.xls" ' chemin fichier 1
chemin2 = "D:\test2.xls" ' chemin fichier 2
chemin3 = "D:\test3.xls" ' chemin fichier 3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Set wb = Workbooks.Open(chemin1)
If wb Is Nothing Then MsgBox "'" & chemin1 & "' introuvable...": Exit Sub
On Error GoTo 0
wb.Sheets(1).Copy
ActiveWorkbook.SaveAs chemin2
ActiveWorkbook.Close False
If wb.Sheets.Count > 2 Then
  wb.Sheets(Array(2, 3)).Copy
  ActiveWorkbook.SaveAs chemin3
  ActiveWorkbook.Close False
End If
wb.Close False
End Sub

J'ai pris soin de mettre des tests de sécurité...

A+

 

[job75]

Re : Eclater un fichier Excel

Re,

Si la macro peut être utilisée sur Excel 2007 et versions ultérieures, il faut préciser le format du fichier :

Sub eclateur_fichier_excel()
Dim chemin1$, chemin2$, chemin3$, wb As Workbook, v
chemin1 = "D:\test.xls" ' chemin fichier 1
chemin2 = "D:\test2.xls" ' chemin fichier 2
chemin3 = "D:\test3.xls" ' chemin fichier 3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Set wb = Workbooks.Open(chemin1)
If wb Is Nothing Then MsgBox "'" & chemin1 & "' introuvable...": Exit Sub
On Error GoTo 0
v = Val(Application.Version)
wb.Sheets(1).Copy
ActiveWorkbook.SaveAs chemin2, IIf(v < 12, xlNormal, 56)
ActiveWorkbook.Close False
If wb.Sheets.Count > 2 Then
  wb.Sheets(Array(2, 3)).Copy
  ActiveWorkbook.SaveAs chemin3, IIf(v < 12, xlNormal, 56)
  ActiveWorkbook.Close False
End If
wb.Close False
End Sub

A+