[VBA] 3 fichier Excel dans un seul !?

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [VBA] 3 fichier Excel dans un seul !?

petburn

bonjour, j'ai un ensemble de fichiers Excel, créé à partir de BO.

le problème, c'est qu'ils sont regroupé par trois.

je souhaiterais donc en VBA, faire un truc du genre :

j'ai donc 3 fichiers (ils ont le même nom, suf un indice...)

je veux :
créer un nouveau fichier cible Excel (même nom, mais sans l'indice donc.)
copier la feuille 1 du fichier 1 dans la feuille 1 du fichier cible
copier la feuille 1 du fichier 2 dans la feuille 2 du fichier cible
copier la feuille 1 du fichier 3 dans la feuille 3 du fichier cible

bien sur sauvegarder le fichier Excel cible.

supprimer les 3 anciens fichier (qui ne me serve plus...)
( un kill fichier1... devrait suffir)

voila,

et je bloque bcp.. en fait, je ne vois pas trop comment partir...

donc si vous avez une idée...

ca sera avec plaisir.

merci d'avance.

et bonne journée.

Publicité

petburn

personne ????
même pas une petite macro ... même si elle n'est pas spécialement faite pour BO (vu que cela ne touchera aucun élement BO.. mais que des fichiers Excels, elle peut etre lancé de n'importe quelle macro VBA...)

JihemAir

Je sais pas

Une toute petite macro, à peine dégrossie:

Public Sub CopySheet()
Dim strNewFile As String
Dim newDoc As Workbook
Dim shTemp As Worksheet

' Création d'un nouveau fichier
' que l'on ouvre.
strNewFile = "c:\temp\New.xls"
Set newDoc = Workbooks.Add

' Ouverture du fichier 1
Workbooks.Open "Fic1.xls"

' On récupère la feuille du fichier 1
Set shTemp = Workbooks("Fic1.xls" ).Worksheets("X1" )

' On copie dans le nouveau fichier
shTemp.Copy after:=newDoc.Worksheets(1)

End Sub

Attention, il reste du boulot:
adapter aux 3 fichiers (je ne connais pas les noms),
s'assurer qu'il n'existe pas déjà une feuille du même nom dans le fichier destination,
sauver le fichier destination,
Détruire les fichiers sources...

---------------
J'ai un message.."Cliquez OK pour continuer."...Qu'est ce que je fais ?

petburn

je met à ma sauce et je teste tout de suite...

merci !!!! :hello:

petburn

ca marche pas,

j'ai modifié comme ca :

Code :

Public Sub CopySheet(lName As String)
Dim strNewFile As String
Dim newDoc As Workbook
Dim shTemp As Worksheet
Dim dpt(1 To 4) As String
dpt(1) = "22"
dpt(2) = "29"
dpt(3) = "35"
dpt(4) = "56"
For i = LBound(dpt) To UBound(dpt)
' Création d'un nouveau fichier
' que l'on ouvre.
strNewFile = "P:\test\prompt\" & lName & "-" & dpt(i) & ".xls"
Set newDoc = Workbooks.Add
' Ouverture du fichier 1
Workbooks.Open "P:\test\prompt\" & lName & "-TabD-" & dpt(i) & ".xls"
' On récupère la feuille du fichier 1
Set shTemp = Workbooks(1).Worksheets(1)
' On copie dans le nouveau fichier
shTemp.Copy after:=newDoc.Worksheets(1)
newDoc.SaveAs (strNewFile)
newDoc.Close
Workbooks.Close
Next
End Sub

je ne vois pas d'ou ca vien...
les fichiers (l y en a 4) sont bien créé... mais ca merdouille... puisque les fichiers sont mal fermé... (il reste un processus EXCEL !!!)

et les fichiers créés ne contiennent rien... sauf une feuille en plus :
j'ai donc :
feuil1 - feuil1 (2) - feuil2 - feuil3

je ne comprends pas ce qui merde....
j'ai oublié de faire quoi ?
qu'est ce que j'ai mal fait ?

Message édité par petburn le 26-04-2004 à 15:11:40

JihemAir

Je sais pas

Ce qui ne va pas?
Set shTemp = Workbooks(1).Worksheets(1)
Tu copies toujours la feuille 1 du fichier 1 du classeur.

newDoc.Close
Workbooks.Close
Tu fermes le fichier dans lequel tu vas effectuer la prochaine copie, puis tu fermes ton classeur.

Essaie qq chose comme ça:

Public Sub CopySheet(lName As String)
Dim strNewFile As String, strOldFile As String
Dim newDoc As Workbook
Dim shTemp As Worksheet
Dim i As Integer
Dim dpt(1 To 4) As String

dpt(1) = "22"
dpt(2) = "29"
dpt(3) = "35"
dpt(4) = "56"

For i = LBound(dpt) To UBound(dpt)

' Création d'un nouveau fichier
' que l'on ouvre.
strNewFile = "P:\test\prompt\" & lName & "-" & dpt(i) & ".xls"
Set newDoc = Workbooks.Add

' Ouverture du fichier source
strOldFile = "P:\test\prompt\" & lName & "-TabD-" & dpt(i) & ".xls"
Workbooks.Open strOldFile

' On récupère la feuille du fichier 1
Set shTemp = Workbooks("strOldFile" ).Worksheets(1)

' On copie dans le nouveau fichier
shTemp.Copy after:=newDoc.Worksheets(1)

newDoc.SaveAs (strNewFile)
Workbooks("strOldFile" ).Close False
Next

End Sub

Et salut les bretons (22, 29, 35, 56).

---------------
J'ai un message.."Cliquez OK pour continuer."...Qu'est ce que je fais ?

petburn

ca marche pas, il ne veux pas de cette ligne :

Code :

Set shTemp = Workbooks("strOldFile" ).Worksheets(1)

et oui, c pour la bretgane... (je suis à rennes... et je bosse pour les bretons... )

JihemAir

Je sais pas

Erreur, j'ai laissé les guillemets...
Set shTemp = Workbooks(strOldFile).Worksheets(1)

Mais tu es sur que la feuille à copier est la 1ère du document?
Il vaut mieux donner son nom:
Set shTemp = Workbooks(strOldFile).Worksheets("NomFeuille" )

---------------
J'ai un message.."Cliquez OK pour continuer."...Qu'est ce que je fais ?

petburn

même sans les guillemets, ca marche pas... :cry:

et pour le nom, je changerai une fois que ca marchera ...
(il faudra mettre des guillemets ???)

JihemAir

Je sais pas

Set shTemp = Worksheets(1)

Yes, il faudra mettre les guillemets si tu donnes lenom de la feuille.

---------------
J'ai un message.."Cliquez OK pour continuer."...Qu'est ce que je fais ?

Publicité

petburn

merci !!!!! :love: ca marche...

par contre, il a aussi fallu que je modifie aussi la fin...

Code :

Workbooks.Close

au lieu de :

Code :

Workbooks("strOldFile" ).Close False

d'ailleurs, je ne comprends pas ce que le False venait faire la...

bref, maintenant, je vais voir pour faire ca avec 3 fichiers dans 1 seul...

donc il y aura peut etre d'autres questions...

en tout cas ... merci bcp JihEmAir !!!!!!!! :hello:

petburn

bon nouvelles erreurs...

voici le code, pour mettre les 3 fichiers dans un seul.

Code :

Public Sub CopySheet(lName As String)
Dim strNewFile As String, strOldFile As String
Dim newDoc As Workbook
Dim shTemp As Worksheet
Dim i As Integer
Dim dpt(1 To 4) As String
dpt(1) = "22"
dpt(2) = "29"
dpt(3) = "35"
dpt(4) = "56"
For i = LBound(dpt) To UBound(dpt)
' Création d'un nouveau fichier
' que l'on ouvre.
strNewFile = "P:\test\prompt\" & lName & "-" & dpt(i) & ".xls"
Set newDoc = Workbooks.Add
' Ouverture du fichier source "tabD"
strOldFile = "P:\test\prompt\" & lName & "-TabD-" & dpt(i) & ".xls"
Workbooks.Open strOldFile
' On récupère la feuille du fichier 1
Set shTemp = Worksheets(1)
' On copie dans le nouveau fichier
shTemp.Copy after:=newDoc.Worksheets(1)
newDoc.SaveAs (strNewFile)
Workbooks.Close
' Ouverture du fichier source "tabS"
strOldFile = "P:\test\prompt\" & lName & "-TabS-" & dpt(i) & ".xls"
Workbooks.Open strOldFile
' On récupère la feuille du fichier 1
Set shTemp = Worksheets(1)
' On copie dans le nouveau fichier
shTemp.Copy after:=newDoc.Worksheets(2)
newDoc.SaveAs (strNewFile)
Workbooks.Close
' Ouverture du fichier source "Graph"
strOldFile = "P:\test\prompt\" & lName & "-Graph-" & dpt(i) & ".xls"
Workbooks.Open strOldFile
' On récupère la feuille du fichier 1
Set shTemp = Worksheets(1)
' On copie dans le nouveau fichier
shTemp.Copy after:=newDoc.Worksheets(3)
newDoc.SaveAs (strNewFile)
Workbooks.Close
Next
End Sub

il me marque une erreur au niveau du 2ème :

Code :

shTemp.Copy after:=newDoc.Worksheets(2)

qu'est ce qui merdouille ?????

nom de l'erreur : erreur automation
l'objet invoqué s'est déconnecté de ses clients !!!???? :??: :??:

Message édité par petburn le 26-04-2004 à 17:17:51

JihemAir

Je sais pas

Tu as fermé Workbook auquel newDoc fait référence, bref, tu lui coupes l'herbe sous le pied.

Il faut conserver la syntaxe que je t'ai donnée, mais j'avais une erreur dans le code (toujours les guillemets):

Code :

Workbooks("strOldFile" ).Close False

a remplacer par

Code :

Workbooks(strOldFile).Close False

Le False, c'est pour dire qu'on ne sauvegarde pas en sortant.

---------------
J'ai un message.."Cliquez OK pour continuer."...Qu'est ce que je fais ?

petburn

il ne veut pas ...

l'indice n'appartient pas à la sélection... !!!!???

code (que j'ai modifié) :

Code :

Public Sub CopySheet(lName As String)
Dim strNewFile As String, strOldFile As String
Dim newDoc As Workbook
Dim shTemp As Worksheet
Dim i As Integer
Dim dpt(1 To 4) As String
dpt(1) = "22"
dpt(2) = "29"
dpt(3) = "35"
dpt(4) = "56"
Dim rep(1 To 3) As String
rep(1) = "-TabD-"
rep(2) = "-TabS-"
rep(3) = "-Graph-"
For i = LBound(dpt) To UBound(dpt)
' Création d'un nouveau fichier
' que l'on ouvre.
strNewFile = "P:\test\prompt\" & lName & "-" & dpt(i) & ".xls"
Set newDoc = Workbooks.Add
For j = LBound(rep) To UBound(rep)
' Ouverture du fichier source "tabD"
strOldFile = "P:\test\prompt\" & lName & rep(j) & dpt(i) & ".xls"
Workbooks.Open strOldFile
' On récupère la feuille du fichier 1
Set shTemp = Worksheets(1)
' On copie dans le nouveau fichier
shTemp.Copy after:=newDoc.Worksheets(j)
newDoc.SaveAs (strNewFile)
Workbooks(strOldFile).Close False
Next
Next
End Sub

il faut que j'enlève des trucs des boucles... ???

JihemAir

Je sais pas

Il ne connait pas Worksheets(j) vu que j, c'est l'indice de la feuille après laquelle il doit copier la nouvelle et que j est aussi ton compteur de boucle (qui augmente à chaque fois). Laisse l'indice à 1.
shTemp.Copy after:=newDoc.Worksheets(1)

et puis pendant qu'on y est, ne sauve pas ton fichier à chaque passage dans la boucle, sauve le après. On gagnera pas mal de temps.
newDoc.SaveAs (strNewFile)

---------------
J'ai un message.."Cliquez OK pour continuer."...Qu'est ce que je fais ?

petburn

ok, mais il plante encore sur

Code :

Workbooks(strOldFile).Close False

PS : merci de m'aider comme ca... je sais que je suis chaint...

petburn

bon, si je vire la ligne :

Code :

Workbooks(strOldFile).Close False

ca marche, j'ai bien les 3 fichiers, mais j'ai toujours les autres fichiers, qui ne sont pas fermés... et je ne peux pas les supprimer...

sinon, quand j'ouvre un fichier qui a été créé... j'ai es autres (ceux qui n'ont pas été fermés... normal...).
et j'ai bienles formats qui sont gardé.. mais les couleurs changent...
et j'ai pas le graphique.. alors qu'il passe bien dans le fichier source...

en plus, quand j'ouvre un fichier cible créé, il me dit que le classeur comporte des liaisons avec un autre classeur.

je voudrais que ce message ne s'affiche pas, et que les liaisons ne soit pas faites...

donc si tu as une idée....

petburn

JihEmAir !!! SVP :cry:

petburn

j'ai des soucis :

j'ai tjs mon problème de processus EXCEL qui ne s'arrete pas...
résultat, je ne peux pas ouvrir les fichiers Excel tant que je n'ai pas killé le processus à la main...(Ctrl Alt Suppr ...)

le graphique est plat (il y a bien un graphique... mais tout est à 0... alors que dans le fichier source, non ( :ange: )

source complet :

Code :

Sub Test()
Dim dpt(1 To 4) As String
dpt(1) = "22"
dpt(2) = "29"
dpt(3) = "35"
dpt(4) = "56"
For i = LBound(dpt) To UBound(dpt)
titre (dpt(i))
fichier (dpt(i))
SetDptPrompt (dpt(i))
ActiveDocument.ExportAsPDF ("P:\test\prompt\" & ActiveDocument.Name & "-" & dpt(i) & ".pdf" )
ActiveDocument.Reports("Tableaux Détaillés" ).ExportAsExcel ("P:\test\prompt\" & ActiveDocument.Name & "-TabD-" & dpt(i) & ".xls" )
ActiveDocument.Reports("Tableaux de Synthèse" ).ExportAsExcel ("P:\test\prompt\" & ActiveDocument.Name & "-TabS-" & dpt(i) & ".xls" )
ActiveDocument.Reports("Graphiques" ).ExportAsExcel ("P:\test\prompt\" & ActiveDocument.Name & "-Graph-" & dpt(i) & ".xls" )
Next
CopySheet (ActiveDocument.Name)
End Sub

Code :

Sub titre(ltitre As String)
Dim myvar_Titre As Variable
Set myvar_Titre = Application.Variables("titre" )
myvar_Titre.Value = ltitre
ActiveReport.ForceCompute
End Sub

Code :

Sub fichier(lfichier As String)
Dim myvar_Fich As Variable
Set myvar_Fich = Application.Variables("fichier" )
myvar_Fich.Value = lfichier
ActiveReport.ForceCompute
End Sub

Code :

Public Sub CopySheet(lName As String)
Dim strNewFile As String, strOldFile As String
Dim newDoc As Workbook
Dim shTemp As Worksheet
Dim i As Integer, j As Integer
Dim dpt(1 To 4) As String
dpt(1) = "22"
dpt(2) = "29"
dpt(3) = "35"
dpt(4) = "56"
Dim rep(1 To 3) As String
rep(1) = "-Graph-"
rep(2) = "-TabS-"
rep(3) = "-TabD-"
For i = LBound(dpt) To UBound(dpt)
' Création d'un nouveau fichier
' que l'on ouvre.
strNewFile = "P:\test\prompt\" & lName & "-" & dpt(i) & ".xls"
Set newDoc = Workbooks.Add
For j = LBound(rep) To UBound(rep)
' Ouverture du fichier source "tabD"
strOldFile = "P:\test\prompt\" & lName & rep(j) & dpt(i) & ".xls"
Workbooks.Open strOldFile
' On récupère la feuille du fichier 1
Set shTemp = Worksheets(1)
' On copie dans le nouveau fichier
shTemp.Copy after:=newDoc.Worksheets(1)
'Workbooks(strOldFile).Close False
Next
' enregistrement du fichier cible
newDoc.SaveAs (strNewFile)
Next
Excel.Application.Quit
' suppression des fichiers temporaires
For i = LBound(dpt) To UBound(dpt)
Kill "P:\test\prompt\" & lName & "-TabD-" & dpt(i) & ".xls"
Kill "P:\test\prompt\" & lName & "-TabS-" & dpt(i) & ".xls"
Kill "P:\test\prompt\" & lName & "-Graph-" & dpt(i) & ".xls"
Next
End Sub

Une fois sur deux (voir aléatoirement), j'ai un message d'erreur :

Citation :

impossible d'accèder à l'objet distant

et je voudrais eviter qu'il me demande si je veux remplacer quand je créé un fichier... et qu'il existe déjà...
=> je le kill avant de la créer ???

voila... donc si vous pouvez m'aider... ca sera super quoi...

merci d'avance.
bonne journée

Message édité par petburn le 27-04-2004 à 15:51:11

JihemAir

Je sais pas

Pour l'Excel qui tourne en tache de fond, c'est parce que tu n'as pas fait le ménage derrière toi en partant. C'est à dire que tu n'as pas nettoyé tes objets. Et ça, c'est pas bien.

Set objet.machin = Nothing

Pour le reste, on verra demain parce que là, j'ai du boulot.

---------------
J'ai un message.."Cliquez OK pour continuer."...Qu'est ce que je fais ?

petburn

ok, pas de prob.

à demain alors... :hello:

petburn

ca ne marche pas.. j'arrive pas à faire le ménage...

j'ai essayé :

Code :

Set Workbooks = Nothing

et il veut pas...

ca vient du fait que j'ai viré la ligne :

Code :

Workbooks(strOldFile).Close False

parceque VBA n'en voulait pas ....

des idées pour mon problème de processus EXCEL... :sweat:

et pour les cas du graphique plat !!!??????? :sweat:

pour le graphique, c'est pas grave, au pire, il ne sera pas incorporé...

mais le processus, je ne peux laisser ca comme ca... :cry:

petburn

toujours personne .... :sweat: ... :cry:

Publicité

FORUM HardWare.fr

Programmation

VB/VBA/VBS

[VBA] 3 fichier Excel dans un seul !?

Sujets relatifs
Problème de taille... de requête!!!!(Excel)	[C++]Port Serie -> Envoi d'un fichier texte...
Extraction et conversion d'un fichier xml en fichier image	programmation de l'exécution d'un fichier batch avec la schtasks
[Word/VBA] 'Modifier Image' sur un .WMF inséré mais en VBA?	Enregistrer et lire une structure dans un fichier
[PHP] Changer localement le niveau d'erreur dans un fichier	macro excel
[Java] parser fichier CSV... JDBC ?	[vbA/word] Comment intégrer une zone de texte ?
Plus de sujets relatifs à : [VBA] 3 fichier Excel dans un seul !?

Page générée en 0.124 secondes