Se connecter avec
S'enregistrer | Connectez-vous

Fusionner plusieur Excel en VBS

Dernière réponse : dans Programmation

Bonjour,

je dois faire une macro qui permet de fusionner plusieurs Excel de même structure en un seul. J'ai choisi le VBS pour qu'il ont juste a cliquer sur une appli pour que ca marche.

mon idée de départ était d'ouvrir un fichier avec le tableau vierge et ensuite d'ouvrir un par un les fichiers remplie et copier le contenu dedans le vierge.

Seul problème, je n'arrive pas a ouvrir X fichier excel ou de les ouvrir puis fermer pour en rouvrir un avec les même variable. Il me dit impossible de lire la method Open.

  1. 'Selection du dossier
    

  2. Set Shell = CreateObject("Shell.Application")
    

  3. Set Folder = Shell.BrowseForFolder(hWnd, "Veuillez selectionner votre Dossier", 0, "")
    

  4. Dim dossier
    

  5. dossier = Folder.items.Item.Path
    

  6.  
  7. 'ouverture du fichier avec le tableau vierge
    

  8. set oXL   = WScript.CreateObject("EXCEL.application" )
    

  9. oXL.Visible = True 
    

  10. oXL.workbooks.open fso.GetFolder("./.")  & "\XXXXX.xls"
    

  11.  
  12.  
  13.  
  14. set xlAp = CreateObject("excel.application")
    

  15. xlAp.Visible = True 
    

  16.  
  17. 'boucle pour ouvrir et fermer les fichier excel du dossier
    

  18. For Each fichier In fso.GetFolder(dossier).Files
    

  19. 	Set fileItem = fso.GetFile(fichier)
    

  20.  
  21. 	if(LCase(Right(fileItem,3)) = "xls") Then
    

  22.  
  23. 		set xlWb = xlAp.Workbooks.open( Fichier )
    

  24. 		xlWb.close
    

  25.  
  26. 	End if
    

  27. Next


Sinon j'avais penser de mettre les objets dans un tableau mais j'arrive à la même erreur.

  1. set xlAp = CreateObject("excel.application")
    

  2. xlAp.Visible = True 
    

  3.  
  4. For Each fichier In fso.GetFolder(dossier).Files
    

  5. 	Set fileItem = fso.GetFile(fichier)
    

  6.  
  7. 	if(LCase(Right(fileItem,3)) = "xls") Then
    

  8.  
  9. 		imax = imax + 1
    

  10.  		ReDim Preserve xlWb(imax)
    

  11. 		set xlWb(imax) = xlAp.Workbooks.open( Fichier )
    

  12.  
  13. 	End if
    

  14. Next



J'ai appris de programmer (on va dire que je me débrouille) sur d'autre langage comme PHP ou Java. Je fais du VBS pour dépanner et là je galère.

Autres pages sur : fusionner plusieur excel vbs

Lassé par la pub ? Créez un compte

Meilleure solution

Expert Programmation

Au temps pour moi, si Folder.items.Item.Path ne fonctionne effectivement pas, Folder.Path non plus. Utilise Folder.Self.Path à la place.

Tu as nettoyé bizarrement !
Ligne 2 : Pourquoi cet objet WScript ?
Ligne 4 et 5 : Pourquoi deux objets FileSystem ?

Appelle tes objets comme tu veux. Mais reste avec une seule logique de nommage. Si tu as du oXL et du objFSA pour les objets appli XL et FileSystem, tu as du folder et du xlWB pour les objets dossier et classeur.

Et arrête avec ton ./. (ça m'énerve, mais ce n'est pas grave.)

Je n'ai pas compris. Le fichier ouvert en ligne 16 est censé exister ou va-t-on le créer ?

Voici ce que j'ai testé chez moi, et qui marche :
  1. Dim fso, shapp, dossier, fichier, xlapp, xlwb
    

  2.  
  3. Set shapp  = CreateObject("Shell.Application" )
    

  4. Set fso    = CreateObject("Scripting.FileSystemObject" )
    

  5. Set xlapp  = CreateObject("Excel.Application")
    

  6. xlapp.Visible = True
    

  7. xlapp.Workbooks.Open fso.GetFolder(".").Path & "\excel_vide.xls"
    

  8.  
  9. Set dossier = fso.GetFolder(shapp.BrowseForFolder(hwnd, "Dossier", 0, "" ).Self.Path)
    

  10. For Each fichier In dossier.Files
    

  11. 	If LCase(fso.GetExtensionName(fichier.path)) = "xls" Then
    

  12. 		Set xlWb = xlapp.Workbooks.open( fichier.path )
    

  13. 		MsgBox "Le classeur '" & fichier.Name & "' est ouvert"
    

  14. 		xlWb.close
    

  15. 	End if
    

  16. Next


Je lance le script dans un répertoire qui contient un classeur qui s'appelle excel_vide.xls, et ça marche très bien.
Expert Programmation

Salut,

Y'a du très bon dans ce code ;) 
Pis du un peu moins bon quand même. :( 

  1. Set Shell = CreateObject("Shell.Application" )
Bien. Mais Shell n'est pas déclarée.
  1. Set Folder = Shell.BrowseForFolder(hWnd, "Veuillez selectionner votre Dossier", 0, "" )
Bien. Mais Folder n'est pas déclarée.
  1. Dim dossier
Très bien
  1. dossier = Folder.items.Item.Path
T'en fais trop. Folder.Path suffit amplement
EDIT: Faux, c'est Folder.Self.Path qu'il faut utiliser.
  1. set oXL  = WScript.CreateObject("EXCEL.application" )
Bien. Mais oXL n'est pas déclarée.
  1. oXL.workbooks.open fso.GetFolder("./." )  & "\XXXXX.xls"
Inutile. ./. c'est deux fois le répertoire courant.
  1. set xlAp = CreateObject("excel.application" )
Pourquoi deux applis Excel ?
  1. For Each fichier In fso.GetFolder(dossier).Files
Très très Bien. Mais fichier n'est pas déclarée.
  1. Set fileItem = fso.GetFile(fichier)
Complètement inutile, et faux en plus. fichier est déjà une variable de type File.
  1. if(LCase(Right(fileItem,3)) = "xls" ) Then
Mouhais. Trop de parenthèses. Et utilise fso.GetExtensionName() plutôt que Right()
  1. set xlWb = xlAp.Workbooks.open( Fichier )
Fichier est une variable de type File. Utilise Fichier.Path pour avoir son chemin.

Alors, ça t'aide ?

J'ai suivi tes conseils, j'ai nettoyé mon script.
Je n'arrive toujours pas à ouvrir 2 classeur à la suite sur la même variable. Il me met toujours : Impossible de lire la propriété Open de la classe Workbooks

  1. Dim WSHShell, fso, objFSO, Shell
    

  2. Set WSHShell = CreateObject("WScript.Shell")
    

  3. Set Shell = CreateObject("Shell.Application" )
    

  4. Set fso = CreateObject("Scripting.FileSystemObject")
    

  5. Set objFSO = CreateObject("Scripting.FileSystemObject")
    

  6.  
  7. 'selection du dossier
    

  8. Dim Folder, dossier
    

  9. Set Folder = Shell.BrowseForFolder(hWnd,"Veuillez selectionner votre Dossier", 0, "")
    

  10. dossier = Folder.items.Item.Path
    

  11.  
  12. 'ouverture du tableau vierge
    

  13. dim oXL
    

  14. set oXL   = WScript.CreateObject("EXCEL.application" )
    

  15. oXL.Visible = True 
    

  16. oXL.workbooks.open fso.GetFolder("./.")  & "\Anomalies BEL gravité 1 et 2.xls"
    

  17.  
  18.  
  19. 'boucle pour ouvrir les fichiers excel du dossier séléctionner
    

  20. Dim fichier
    

  21. For Each fichier In fso.GetFolder(dossier).Files
    

  22.  
  23. 	if(fso.GetExtensionName(fichier.path) = "xls") Then
    

  24.  
  25. msgbox fichier.path		
    

  26.  
  27. 		Dim xlwb
    

  28. 		set xlWb = oXL.Workbooks.open( fichier.path )
    

  29. 		xlWb.close
    

  30.  
  31. 	End if
    

  32. Next

Ton code correspond bien a ce que je veux faire.

Mais j'ai toujours mon problème, j'arrive à ouvrir un seul fichier Excel via la boucle, quand il essaye d'ouvrir un 2éme fichier dans le répertoire, il affiche une erreur :

Ligne 12
Caract : 10
erreur : impossible de lire la propriété Open de la classe Workbook.
Code : 800A03EC
Source : Microsoft Excel

Je ne vois pas ou ca bloque. Tu as essayé avec plusieurs fichier dans un répértoire.
Expert Programmation

Salut,

Sois très précis, s'il te plaît. C'est la classe Workbook ou la classe Workbooks qui pose problème ?

Que contient la variable fichier.path au premier tour ? Au second ?

Je viens de refaire le test et en effet j'avais oublié le S de workbooks.

Ligne 12
Caract : 10
erreur : impossible de lire la propriété Open de la classe Workbooks.
Code : 800A03EC
Source : Microsoft Excel

Sinon je viens de trouver le problème. Le 2éme fichier excel que je voulais ouvrir été vérolé donc cela ne venais pas du code mais du fichier.

Je vous jure, je me sens con.
Merci de votre aide, cela ma permit de rendre mon code beaucoup plus propre.
Lassé par la pub ? Créez un compte

Créer un nouveau sujet