Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1437 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [VBA][Excel] Problème d'ecriture dans un nouveau document

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

[VBA][Excel] Problème d'ecriture dans un nouveau document

n°1767303
fatloui
I'll be back
Posté le 31-07-2008 à 14:55:48  profilanswer
 

Bonjour,
 
J'ai voulu ecrire une macro qui trie les données d'un fichier excel et qui copie dans 2 fichiers excel differents
Cependant, je crée bien les deux fichiers mais je n'arrive pas à ecrire dessus. Je ne vois pas ou est mon erreur
 

Code :
  1. Sub extract_fiche()
  2. ' Creation de deux nouveaux fichiers excel
  3. Dim xlApp As New Excel.Application
  4. Dim xlBook1 As Workbook
  5. Dim xlBook2 As Workbook
  6. Dim NomFichier1 As String
  7. Dim NomFichier2 As String
  8. Set xlApp1 = CreateObject("Excel.Application" )
  9. Set xlBook1 = xlApp1.Workbooks.Add
  10. xlApp1.Visible = True
  11. Set xlApp2 = CreateObject("Excel.Application" )
  12. Set xlBook2 = xlApp2.Workbooks.Add
  13. xlApp2.Visible = True
  14. Application.ScreenUpdating = False
  15. Wtool = ActiveWorkbook.Name
  16. ' selection d'une feuille dans le classeur ayant lancé la macro
  17. Sheets("clos SA EDI par categorie" ).Select
  18. ' Copie de la premiere ligne de la feuille selectionnée
  19. enTete = Range("A1", "J1" )
  20. t1 = 0
  21. t2 = 0
  22. For i = 1 To Range("A1000" ).End(xlUp).Row
  23.      
  24.       ' Selection d'une ligne du fichier ayant lancé la macro
  25.       Rfc = Range("A" & i, "J" & i)
  26.      
  27.      ' Si cette ligne contient le mot "incident" on rentre dans la boucle
  28.     If Range("A" & i).Text = "Incident" Then
  29.          t1 = t1 + 1
  30.            
  31.              ' Activer un deuxieme classeur
  32.              xlBook1.Activate
  33.          
  34.         ' Activer une feuille de ce classeur
  35.         xlBook1.Sheets("Feuil1" ).Select
  36.        
  37.         If t1 = 1 Then
  38.            ' La premiere fois que j'entre dans la boucle je recopie l'entete puis la ligne qui contient "incident"
  39.            Range("A1", "J1" ) = enTete       
  40.             firstline = Range("A1000" ).End(xlUp).Row + 1
  41.            Range("A" & firstline, "J" & firstline) = Rfc
  42.         Else
  43.              ' recopie la ligne contenant "incident"
  44.              firstline = Range("A1000" ).End(xlUp).Row + 1
  45.             Range("A" & firstline, "J" & firstline) = Rfc
  46.          End If
  47.        
  48.        
  49.     ' Si contient   "Request for Standard Change" on entre la boucle 
  50.     ElseIf Range("A" & i).Text = "Request for Standard Change" Then
  51.      t2 = t2 + 1
  52.    
  53.              xlBook2.Activate
  54.         xlBook2.Sheets("Feuil2" ).Select
  55.        
  56.                 If t2 = 1 Then
  57.              Range("A1", "J1" ) = enTete
  58.              Else
  59.              firstline = Range("A1000" ).End(xlUp).Row + 1
  60.              Range("A" & firstline, "J" & firstline) = Rfc
  61.        
  62.               End If
  63.     End If
  64. ' on reactive le classeur ayant lancé la macro
  65.     ThisWorkbook.Activate
  66.     Sheets("clos SA EDI par categorie" ).Select
  67.    Next i
  68. NomFichier1 = "clos SA EDI_Incidents.xls"
  69. xlBook1.SaveAs NomFichier1
  70. xlBook1.Close
  71. xlApp1.Quit
  72. NomFichier2 = "clos SA EDI_RFC.xls"
  73. xlBook2.SaveAs NomFichier2
  74. xlBook2.Close
  75. xlApp2.Quit
  76. Set xlBook1 = Nothing
  77. Set xlApp1 = Nothing
  78. Set xlBook2 = Nothing
  79. Set xlApp2 = Nothing
  80. End Sub


Merci de votre aide.
 
Je suis debutante dans ce langage et je ne trouve pas de bon tutoriels dessus sur internet. Si quelqu'un a la perle rare, je suis preneuse.


Message édité par fatloui le 01-08-2008 à 09:49:04
mood
Publicité
Posté le 31-07-2008 à 14:55:48  profilanswer
 

n°1767478
galopin01
Posté le 31-07-2008 à 20:31:45  profilanswer
 

bonjour,
Je ne vais pas out détailler cr je n'ai p

n°1767479
galopin01
Posté le 31-07-2008 à 20:33:11  profilanswer
 

galopin01 a écrit :

bonjour,
Je ne vais pas out détailler cr je n'ai p


...Oups ! Sorry... la suite dans quelques instants !...

n°1767487
galopin01
Posté le 31-07-2008 à 20:50:44  profilanswer
 

Bonjour,
je ne vais pas tout détailler car je n'ai sans doute pas tout compris dans ce que tu voulais faire, mais la source de tes problèmes est sans doute dans la ligne 22 et leur correspondant ligne 38 et 53.
Il est probable que tu veux stocker les valeurs des cellules correspondantes mais ta manière de faire est un peu cavalière...
Il faut faire  
var1 = range("A1" ) (*1)
var2 = range("J1" ) (*1)
De même (pour les même raisons) ton Rfc (et les instructions qui en découlent lignes 41 et 56) me semble aussi incohérents...
Bon tes variables sont pas trop détaillées et tes Activate/Select font un peu "doigt dans le nez", mais à la limite ça empêche pas de fonctionner.  
Par contre les observations précédentes sont déterminantes.
 
Nota : (*1) j'ai comme un doute... (ta notation est incompréhensible) Si tu veux juste copier les colonnes A et J : Ok  
Sinon si tu veux copier toute les colonnes entre A et J, là c'est une autre histoire... Il faut préciser...
A+


Message édité par galopin01 le 31-07-2008 à 22:32:03
n°1767537
fatloui
I'll be back
Posté le 31-07-2008 à 22:46:21  profilanswer
 

Merci pour ta réponse.
En fait je veux bien copier toute la ligne. Mon code n'est pas commenté, je le ferai demain.
En fait ce code fonctionne bien quand je veux ecrire dans un onglet dans le classeur ayant lancé la macro mais lorsque je souhaite creer 2 nouveaux classeur et ecrire dedans, ca ne fonctionne pas. J'ai pas de bugs, les classeurs sont bien crée mais rien est ecrit dedans.
 
Il me semble que c'est l'activation du classeur qui deconne ou la selection de la feuille

Code :
  1. xlBook1.Activate
  2.          xlBook1.Sheets("Feuil1" ).Select

n°1767578
galopin01
Posté le 01-08-2008 à 07:51:57  profilanswer
 

Non.  
Ce sont bien les lignes que je t'ai citées qui posent problèmes mais
enTete = Range("A1", "J1" )
ainsi que son inverse
Range("A1", "J1" ) = enTete
de même que  
Rfc = Range("A" & i, "J" & i)
et  
Range("A" & firstline, "J" & firstline) = Rfc
ces construction sont impropres.
Je n'ai pas le temps de détailler plus ce matin car je vais au boulot, mais regarde de ce coté là.
A+

n°1767621
fatloui
I'll be back
Posté le 01-08-2008 à 09:50:41  profilanswer
 

en fait je vois pas où est mon erreur
j'ai edité mon premier post pour y inclure les commentaire.
Lorsque j'utilise les fonctions que tu m'as cité pour copier dans une nouvelle feuille ca fonctionne mais dans un nouveau classeur non

n°1767626
fatloui
I'll be back
Posté le 01-08-2008 à 09:55:30  profilanswer
 

Effectivement, je n'ai meme pas expliqué ce que je souhaitai faire.
En fait je veux lancer la macro dans un fichier excel contenant plusieurs lignes. Je veux verifier si la ligne contient un mot et en fonction de ce que je trouve, je veux copier cette ligne soit dans un nouveau fichier que j'ai créé soit dans un deuxieme nouveau fichier que j'ai créé egalement

n°1767657
MagicBuzz
Posté le 01-08-2008 à 10:20:26  profilanswer
 

éviter de jouer avec des range.select() et workbook.activate().
 
pour les raisons suivantes :
1/ excel se met à afficher rapidement plusieurs documents dans tous les sens, et ça fait peur à l'utilisateur (sans compter que ça divise par 20 la vitesse de la macro). dans le meilleur des cas, l'utilisateur devient chèvre après une crise d'épilespsie, et dans le pire des cas il éteinds tout avant d'aller vomir.
2/ quand on lance un traîtement qui peut durer du temps, on aime bien faire autrechose (réserver son billet d'avion pour les vacances, faire une partie de solitaire, bosser sur autrechose, etc.) avec des fenêtres qui prennent lefocus sans arrêt, c'est impossible et particulièrement gonflant pour l'utilisateur qui n'a d'autre solution que de partir en pause café.
3/ si par malheur l'utlisateur clique sur une fenêtre, fait ctrl+tab pour en afficher une autre, ou ouvre une nouvelle session excel, la macro va commencer à faire n'importe quoi, genre lui pourrir un fichier qui n'a rien à voir avec la macro, écrire n'importe quoi n'importe où, etc.
 
bref, objectivement, le seul intérêt que je vois à ça, c'est que c'est ce que génère Excel quand on enregistre une macro...
 
pour copier un range d'un workbook à un autre, on fait ça :

Code :
  1. Sub plop()
  2.    Dim wkb1 As Workbook
  3.    Dim wkb2 As Workbook
  4.    
  5.    Set wbk1 = ThisWorkbook
  6.    Set wkb2 = Workbooks.Add()
  7.    
  8.    wkb1.Sheets(1).Range("A1:J10" ).Copy (wkb2.Sheets(1).Cells(5, 5))
  9. End Sub

n°1767659
MagicBuzz
Posté le 01-08-2008 à 10:22:21  profilanswer
 

et entre la ligne 6 et la ligne 8, l'utilisateur peut faire tout ce qu'il veut. le workbooks.add() a effectivement fait apparaître le nouveau classeur (on doit pouvoir le cacher), mais ensuite la macro se moque éperduement de l'état des fenêtres ou de ce qu'est en train de faire l'utilisateur.


Message édité par MagicBuzz le 01-08-2008 à 10:22:41
mood
Publicité
Posté le 01-08-2008 à 10:22:21  profilanswer
 

n°1767979
galopin01
Posté le 01-08-2008 à 17:28:49  profilanswer
 

Bonsoir,
la macro revue et corrigée :

Code :
  1. Sub extract_fiche()
  2. Dim Wb1 As Workbook
  3. Dim Wb2 As Workbook
  4. Dim WsO As Worksheet
  5. Dim Ws1 As Worksheet
  6. Dim Ws2 As Worksheet
  7. Dim Zone() 'c'est un array
  8. Dim i%, k%, x%, y% 'integer...
  9. Application.ScreenUpdating = False
  10. 'on travaille sur une instance (à cause du nom long...)
  11. Set WsO = Worksheets("clos SA EDI par categorie" )
  12. 'Creation de deux nouveaux fichiers excel
  13. Set Wb1 = Workbooks.Add
  14. Set Wb2 = Workbooks.Add
  15. 'On travaille sur des instances de feuilles de chaque fichier
  16. Set Ws1 = Wb1.Worksheets("Feuil1" )
  17. Set Ws2 = Wb2.Worksheets("Feuil2" )
  18. 'mémorisation de la premiere ligne de la feuille selectionnée
  19. Zone = WsO.Range("A1:J1" )
  20. 'initialisation de la première ligne de chaque classeur
  21. Ws1.Range("A1:J1" ) = Zone
  22. Ws2.Range("A1:J1" ) = Zone
  23. x = 1
  24. y = 1
  25. 'pour limiter la zone de travail
  26. k = WsO.Range("A1000" ).End(xlUp).Row
  27. For i = 1 To k
  28.    
  29.      ' Si cette ligne contient le mot "incident" ou "Request for Standard Change"
  30.      'on rentre dans la boucle
  31.     If WsO.Range("A" & i) = "Incident" Or WsO.Range("A" & i) = "Request for Standard Change" Then
  32.       'mémorisation de la ligne du fichier ayant lancé la macro
  33.       Zone = WsO.Range("A" & i & ":J" & i)
  34.       If WsO.Range("A" & i) = "Incident" Then
  35.         x = x + 1
  36.         Ws1.Range("A" & x & ":J" & x) = Zone
  37.       Else
  38.         y = y + 1
  39.         Ws2.Range("A" & y & ":J" & y) = Zone
  40.       End If
  41.     End If
  42. Next
  43. Wb1.SaveAs "clos SA EDI_Incidents.xls"
  44. Wb1.Close
  45. Wb2.SaveAs "clos SA EDI_RFC.xls"
  46. Wb2.Close
  47. Set Wb1 = Nothing
  48. Set Wb1 = Nothing
  49. Set Ws1 = Nothing
  50. Set Ws2 = Nothing
  51. MsgBox "c'est fini"
  52. End Sub


Remarque: il n'y a pas d'activation, pas de select... J'ai utilisé un Array mais si tu ne sais pas ce que c'est, on peut aussi faire un copier/coller façon MagicBuzz.
A+

n°1768197
fatloui
I'll be back
Posté le 02-08-2008 à 07:15:56  profilanswer
 

Merci beaucoup galopin. C'est beaucoup plus propre que mon code :p


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [VBA][Excel] Problème d'ecriture dans un nouveau document

 

Sujets relatifs
Probleme avec la fonction unlink[RESOLU] VBA variable differente en fonction du bouton clicke
problème avec a:hoverCopier coller VBA
Probleme de Script PHP[Résolu]Probleme Surlignement ligne avec Javascript
[ VB6 ] Enregistrer Données ( combobox.txt, textbox.txt ) sous EXCELprobleme de configurationde certaine module
Problème avec FormulaR1C1Java Excel nombre
Plus de sujets relatifs à : [VBA][Excel] Problème d'ecriture dans un nouveau document


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR