[VBA] 3 fichier Excel dans un seul !?

3 fichier Excel dans un seul !? [VBA] - VB/VBA/VBS - Programmation

Marsh Posté le 22-04-2004 à 12:36:19    

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.

Reply

Marsh Posté le 22-04-2004 à 12:36:19   

Reply

Marsh Posté le 26-04-2004 à 10:25:37    

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...)

Reply

Marsh Posté le 26-04-2004 à 11:33:08    

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 ?
Reply

Marsh Posté le 26-04-2004 à 13:38:53    

je met à ma sauce et je teste tout de suite...
 
merci !!!!  :hello:

Reply

Marsh Posté le 26-04-2004 à 15:10:19    

ca marche pas,
 
j'ai modifié comme ca :

Code :
  1. Public Sub CopySheet(lName As String)
  2. Dim strNewFile As String
  3. Dim newDoc As Workbook
  4. Dim shTemp As Worksheet
  6. Dim dpt(1 To 4) As String
  7.         dpt(1) = "22"
  8.         dpt(2) = "29"
  9.         dpt(3) = "35"
  10.         dpt(4) = "56"
  11.        
  12.     For i = LBound(dpt) To UBound(dpt)
  13.    
  14.         ' Création d'un nouveau fichier
  15.         ' que l'on ouvre.
  16.         strNewFile = "P:\test\prompt\" & lName & "-" & dpt(i) & ".xls"
  17.         Set newDoc = Workbooks.Add
  18.    
  19.         ' Ouverture du fichier 1
  20.         Workbooks.Open "P:\test\prompt\" & lName & "-TabD-" & dpt(i) & ".xls"
  21.    
  22.         ' On récupère la feuille du fichier 1
  23.         Set shTemp = Workbooks(1).Worksheets(1)
  24.        
  25.         ' On copie dans le nouveau fichier
  26.         shTemp.Copy after:=newDoc.Worksheets(1)
  27.        
  28.         newDoc.SaveAs (strNewFile)
  29.         newDoc.Close
  30.         Workbooks.Close
  31.     Next
  32.    
  33. 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
Reply

Marsh Posté le 26-04-2004 à 15:29:37    

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 ?
Reply

Marsh Posté le 26-04-2004 à 15:39:13    

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

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


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

Reply

Marsh Posté le 26-04-2004 à 15:47:58    

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 ?
Reply

Marsh Posté le 26-04-2004 à 16:17:38    

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 ???)

Reply

Marsh Posté le 26-04-2004 à 16:28:59    

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 ?
Reply

Marsh Posté le 26-04-2004 à 16:28:59   

Reply

Marsh Posté le 26-04-2004 à 16:54:03    

merci !!!!!  :love:  ca marche...
 
par contre, il a aussi fallu que je modifie aussi la fin...
 

Code :
  1. Workbooks.Close

au lieu de :

Code :
  1. 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:

Reply

Marsh Posté le 26-04-2004 à 17:04:20    

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

Code :
  1. Public Sub CopySheet(lName As String)
  2. Dim strNewFile As String, strOldFile As String
  3. Dim newDoc As Workbook
  4. Dim shTemp As Worksheet
  5. Dim i As Integer
  6. Dim dpt(1 To 4) As String
  8.           dpt(1) = "22"
  9.           dpt(2) = "29"
  10.           dpt(3) = "35"
  11.           dpt(4) = "56"
  12.            
  13.       For i = LBound(dpt) To UBound(dpt)
  14.        
  15.           ' Création d'un nouveau fichier
  16.           ' que l'on ouvre.
  17.           strNewFile = "P:\test\prompt\" & lName & "-" & dpt(i) & ".xls"
  18.           Set newDoc = Workbooks.Add
  19.        
  20.          
  21.          
  22.          
  23.           ' Ouverture du fichier source "tabD"
  24.           strOldFile = "P:\test\prompt\" & lName & "-TabD-" & dpt(i) & ".xls"
  25.           Workbooks.Open strOldFile
  26.        
  27.           ' On récupère la feuille du fichier 1
  28.           Set shTemp = Worksheets(1)
  29.        
  30.           ' On copie dans le nouveau fichier
  31.           shTemp.Copy after:=newDoc.Worksheets(1)
  32.            
  33.           newDoc.SaveAs (strNewFile)
  34.           Workbooks.Close
  35.          
  36.          
  37.          
  38.          
  39.           ' Ouverture du fichier source "tabS"
  40.           strOldFile = "P:\test\prompt\" & lName & "-TabS-" & dpt(i) & ".xls"
  41.           Workbooks.Open strOldFile
  42.        
  43.           ' On récupère la feuille du fichier 1
  44.           Set shTemp = Worksheets(1)
  45.        
  46.           ' On copie dans le nouveau fichier
  47.           shTemp.Copy after:=newDoc.Worksheets(2)
  48.            
  49.           newDoc.SaveAs (strNewFile)
  50.           Workbooks.Close
  51.          
  52.          
  53.            
  54.            ' Ouverture du fichier source "Graph"
  55.           strOldFile = "P:\test\prompt\" & lName & "-Graph-" & dpt(i) & ".xls"
  56.           Workbooks.Open strOldFile
  57.        
  58.           ' On récupère la feuille du fichier 1
  59.           Set shTemp = Worksheets(1)
  60.        
  61.           ' On copie dans le nouveau fichier
  62.           shTemp.Copy after:=newDoc.Worksheets(3)
  63.            
  64.           newDoc.SaveAs (strNewFile)
  65.           Workbooks.Close
  66.      
  67.      
  68.      
  69.       Next
  70.        
  71.   End Sub


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

Code :
  1. 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
Reply

Marsh Posté le 27-04-2004 à 07:54:18    

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 :
  1. Workbooks("strOldFile" ).Close False


a remplacer par

Code :
  1. 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 ?
Reply

Marsh Posté le 27-04-2004 à 09:00:29    

il ne veut pas ...
 
l'indice n'appartient pas à la sélection... !!!!???
 
code (que j'ai modifié) :

Code :
  1. Public Sub CopySheet(lName As String)
  2. Dim strNewFile As String, strOldFile As String
  3. Dim newDoc As Workbook
  4. Dim shTemp As Worksheet
  5. Dim i As Integer
  7. Dim dpt(1 To 4) As String
  8.     dpt(1) = "22"
  9.     dpt(2) = "29"
  10.     dpt(3) = "35"
  11.     dpt(4) = "56"
  12.    
  13. Dim rep(1 To 3) As String
  14.     rep(1) = "-TabD-"
  15.     rep(2) = "-TabS-"
  16.     rep(3) = "-Graph-"
  17.            
  18.     For i = LBound(dpt) To UBound(dpt)
  19.        
  20.           ' Création d'un nouveau fichier
  21.           ' que l'on ouvre.
  22.           strNewFile = "P:\test\prompt\" & lName & "-" & dpt(i) & ".xls"
  23.           Set newDoc = Workbooks.Add
  24.        
  25.         For j = LBound(rep) To UBound(rep)
  26.          
  27.              
  28.           ' Ouverture du fichier source "tabD"
  29.           strOldFile = "P:\test\prompt\" & lName & rep(j) & dpt(i) & ".xls"
  30.           Workbooks.Open strOldFile
  31.        
  32.           ' On récupère la feuille du fichier 1
  33.           Set shTemp = Worksheets(1)
  34.        
  35.           ' On copie dans le nouveau fichier
  36.           shTemp.Copy after:=newDoc.Worksheets(j)
  37.            
  38.           newDoc.SaveAs (strNewFile)
  39.           Workbooks(strOldFile).Close False
  40.          
  41.         Next
  42.      
  43.       Next
  44.        
  45.   End Sub


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

Reply

Marsh Posté le 27-04-2004 à 09:13:11    

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 ?
Reply

Marsh Posté le 27-04-2004 à 09:27:06    

ok, mais il plante encore sur  

Code :
  1. Workbooks(strOldFile).Close False


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

Reply

Marsh Posté le 27-04-2004 à 10:39:12    

bon, si je vire la ligne :

Code :
  1. 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....

Reply

Marsh Posté le 27-04-2004 à 15:10:56    

JihEmAir !!! SVP  :cry:

Reply

Marsh Posté le 27-04-2004 à 15:45:04    

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 :
  1. Sub Test()
  2.     Dim dpt(1 To 4) As String
  3.         dpt(1) = "22"
  4.         dpt(2) = "29"
  5.         dpt(3) = "35"
  6.         dpt(4) = "56"
  7.        
  8.     For i = LBound(dpt) To UBound(dpt)
  9.         titre (dpt(i))
  10.         fichier (dpt(i))
  11.         SetDptPrompt (dpt(i))
  12.         ActiveDocument.ExportAsPDF ("P:\test\prompt\" & ActiveDocument.Name & "-" & dpt(i) & ".pdf" )
  13.         ActiveDocument.Reports("Tableaux Détaillés" ).ExportAsExcel ("P:\test\prompt\" & ActiveDocument.Name & "-TabD-" & dpt(i) & ".xls" )
  14.         ActiveDocument.Reports("Tableaux de Synthèse" ).ExportAsExcel ("P:\test\prompt\" & ActiveDocument.Name & "-TabS-" & dpt(i) & ".xls" )
  15.         ActiveDocument.Reports("Graphiques" ).ExportAsExcel ("P:\test\prompt\" & ActiveDocument.Name & "-Graph-" & dpt(i) & ".xls" )
  16.     Next
  17.         CopySheet (ActiveDocument.Name)
  18.        
  19. End Sub


 

Code :
  1. Sub titre(ltitre As String)
  2.     Dim myvar_Titre As Variable
  3.     Set myvar_Titre = Application.Variables("titre" )
  4.     myvar_Titre.Value = ltitre
  5.     ActiveReport.ForceCompute
  6. End Sub


 

Code :
  1. Sub fichier(lfichier As String)
  2.     Dim myvar_Fich As Variable
  3.     Set myvar_Fich = Application.Variables("fichier" )
  4.     myvar_Fich.Value = lfichier
  5.     ActiveReport.ForceCompute
  6. End Sub


 

Code :
  1. Public Sub CopySheet(lName As String)
  2. Dim strNewFile As String, strOldFile As String
  3. Dim newDoc As Workbook
  4. Dim shTemp As Worksheet
  5. Dim i As Integer, j As Integer
  7. Dim dpt(1 To 4) As String
  8.     dpt(1) = "22"
  9.     dpt(2) = "29"
  10.     dpt(3) = "35"
  11.     dpt(4) = "56"
  12.    
  13. Dim rep(1 To 3) As String
  14.     rep(1) = "-Graph-"
  15.     rep(2) = "-TabS-"
  16.     rep(3) = "-TabD-"
  17.    
  18.                
  19.     For i = LBound(dpt) To UBound(dpt)
  20.            
  21.           ' Création d'un nouveau fichier
  22.           ' que l'on ouvre.
  23.           strNewFile = "P:\test\prompt\" & lName & "-" & dpt(i) & ".xls"
  24.           Set newDoc = Workbooks.Add
  25.        
  26.         For j = LBound(rep) To UBound(rep)
  27.                      
  28.           ' Ouverture du fichier source "tabD"
  29.           strOldFile = "P:\test\prompt\" & lName & rep(j) & dpt(i) & ".xls"
  30.           Workbooks.Open strOldFile
  31.        
  32.           ' On récupère la feuille du fichier 1
  33.           Set shTemp = Worksheets(1)
  34.        
  35.           ' On copie dans le nouveau fichier
  36.           shTemp.Copy after:=newDoc.Worksheets(1)
  37.            
  38.          
  39.           'Workbooks(strOldFile).Close False
  40.                    
  41.         Next
  42.             ' enregistrement du fichier cible
  43.             newDoc.SaveAs (strNewFile)
  44.       Next
  45.     Excel.Application.Quit
  46.    
  47.     ' suppression des fichiers temporaires
  48.     For i = LBound(dpt) To UBound(dpt)
  49.         Kill "P:\test\prompt\" & lName & "-TabD-" & dpt(i) & ".xls"
  50.         Kill "P:\test\prompt\" & lName & "-TabS-" & dpt(i) & ".xls"
  51.         Kill "P:\test\prompt\" & lName & "-Graph-" & dpt(i) & ".xls"
  52.     Next
  53.            
  54.   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
Reply

Marsh Posté le 27-04-2004 à 17:11:51    

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 ?
Reply

Marsh Posté le 27-04-2004 à 17:16:47    

ok, pas de prob.
 
à demain alors...  :hello:

Reply

Marsh Posté le 28-04-2004 à 16:16:57    

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

Code :
  1. Set Workbooks = Nothing


 
et il veut pas...
 
ca vient du fait que j'ai viré la ligne :

Code :
  1. 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:

Reply

Marsh Posté le 30-04-2004 à 10:15:57    

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

Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed