VB6 et ajouter une feuille à un classeur Excel. [Résolu]

LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 18:28 - Dernière réponse : LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention
- 2 juil. 2008 à 11:23
Salut,
Sous VB6 et dans une routine qui me permet d' envoyer des
données vers un classeur Excel, j' ai ceci:


Sub ENVOYER()


'OUVRIR LA TABLE


    Dim rs As Recordset
    Set rs = pDB.OpenRecordset("INSCRIPTIONS", dbOpenDynaset)


'- Ouvrir un fichier Excel
'Déclaration des variables
    Dim appExcel As Excel.Application 'Application Excel
    Dim wbExcel As Excel.Workbook 'Classeur Excel
    Dim wsExcel As Excel.Worksheet 'Feuille Excel


'Ouverture de l'application
    Set appExcel = CreateObject("Excel.Application")
  'Ouverture d'un fichier Excel
    Set wbExcel = appExcel.Workbooks.Open(App.Path & "\NXLS.xls")


rs.MoveFirst
Dim i As Integer, y As Integer, xPage As Integer


  y = 0
   xPage = 1
  'wsExcel correspond à la première feuille du fichier
  Set wsExcel = wbExcel.Worksheets(xPage)
 
  With wsExcel
     .Activate
    Do While Not rs.EOF
            'LIRE L' ENREGISTREMENT
            'ET
            'ECRIRE DANS EXCEL
            y = y + 1
    
           'pour avoir 12 lignes par page
             If y = 12 Then  
               If xPage = wbExcel.Worksheets.Count Then
                 'AJOUTER UNE FEUILLE
                  wbExcel.Worksheets.Add , , xPage, 1
               End If
                 xPage = xPage + 1
                
                 'ACTIVER LA DERNIERE PAGE
                 Set wsExcel = wbExcel.Worksheets(xPage)
                .Activate
                y = 1
             End If
           
            .Cells(y, 1) = rs!Nom
            .Cells(y, 2) = rs!Prenom
            .Cells(y, 3) = rs!Ne_le
             .Cells(y, 3) = rs!ArNom
             wsExcel.Cells(y, 3) = rs!ArPrenom
         
            'IMPRIMER
            '.PrintOut
           
            'SUIVANT
            rs.MoveNext
    Loop
MsgBox "TERMINE"


'AFFICHER EXCEL
     wbExcel.Windows.Application.Visible = True


'FERMER EXCEL
   ' .Close False
 
 End With


'
'...DETRUIRE LES OBJETS
 Set appExcel = Nothing
 Set wbExcel = Nothing
 Set wsExcel = Nothing
  MsgBox " Objet fermé"
End Sub


Je sais qu' au niveau code, c' est un peu juste,
mais c' est tout ce que j' ai pu faire :-).
Et à vrai dire le problème se situe ailleurs.
En effet, lorsque j' ajoute une nouvelle feuille,
celle ci se retrouve à gauche de celle qui était la dernière.
Quelqu' un peut-il m' aider à faire en sorte que la
dernière ajoutée soit toujours à droite.


Merci.


NB: Vous m' excuserez si j' ai mal choisi le thème.





<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Afficher la suite 

Votre réponse

23 réponses

Meilleure réponse
PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention - 2 juil. 2008 à 00:57
3
Merci
le .activate était donc bien un "point" bien placé ^^

désolé pour ton clin d'oeil, on est pas toujours dispo 24/24

cette réponse t'aide? ^^

remplace tous tes cell et feuill (à comprendre) par des affichages en debug.print pour voir déjà si VB6 fait le nécessaire.

(si on est hors lot tous les 2, au moins déjà voir si c'est la syntaxe excel qui peut poser problème)
<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp  

Merci PCPT 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 72 internautes ce mois-ci

Commenter la réponse de PCPT
Meilleure réponse
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 2 juil. 2008 à 05:59
3
Merci
Salut,

Apres avoir ecrit tout ce qui ce trouve ci-dessous et au moment de la conclusion je me suis rendu compte de l' erreur. La ligne essentielle xPage = xPage + 1 n'etait pas a sa place les commentaire en orange on etes ajoutes apre la conclusion... ouai je sais c'est pas tres logique

non, non avec excel il n'y a absolument pas besoin d'activer une feuille et/ou une cellule pour attribuer une valeur a une cellule. moi j'aurai plutot un doute sur ton recordset.(ce que je pensait avant la conclusion) 
De plus quand tu ajoutes une feuille, la feuille ajoutee devient automatiquement la feuille active.
En faite si c'etait un probleme de feuille active tu n'aurais le probleme que sur les feuille 2, et 3 car la premiere est elle aussi active par defaut apres ouverture du fichier.(la je le pense toujours)

pour verifie ce que je vient de t' expliquer ce n' est pas complique, tu ajoutes une message box comme suit:

         Msgbox .ActiveSheet.Name
         with .Worksheets(xPage)
                .Cells(y, 1).Value = rs!Nom
                .Cells(y, 2).Value = rs!Prenom
                .Cells(y, 3).Value = rs!Ne_le
                .Cells(y, 4).Value = rs!ArNom
                .Cells(y, 5).Value = rs!ArPrenom
           End With

tu devrais voir le nom de la feuille active a l'ouverture du fichier. Tu la veras 3 fois puis ensuite le nom des feuilles ajoutees.(apres avoir replace  xPage = xPage + 1 a sa place c' est effectivement ce qui devrait ce passer)

Enfin avec la methode que je t'ai donne le seul probleme qu' il peu y avoir c'est d'attribuer une valeur a un objet qui n' existe pas, soit le document, soit la feuille ou encore la cellule et tu aurais alors le message :
Runtime error 9, Subscript out of Range

Et pour ajouter une confirmation, puisque tu dis avoir 280 valeur a importer remplace temporairement.(je persite et signe)
If y 12 Then    par     If y 281 Then

tu devrais alors avoir toute tes donnes sur la 1ere page qui en plus est la page active a l'ouverture du fichier.

et pour conclure je te redonne, en version complete, ce que je pense etre la bonne methode cote excel:(version corrigee)

With wbExcel
     .Activate
    Do While Not rs.EOF
            'LIRE L' ENREGISTREMENT
            'ET
            'ECRIRE DANS EXCEL
            y = y + 1
    
           'pour avoir 12 lignes par page             If y 13 Then   'si y 12 on doit changer de page
               If xPage = .Worksheets.Count Then 'si on est a la derniere page deja existante
                 'AJOUTER UNE FEUILLE
                  .Worksheets.Add , xPage, 1
               End If
               xPage = xPage + 1
                y = 1
             End If
            with .Worksheets(xPage)
                .Cells(y, 1).Value = rs!Nom
                .Cells(y, 2).Value = rs!Prenom
                .Cells(y, 3).Value = rs!Ne_le
                .Cells(y, 4).Value = rs!ArNom
                .Cells(y, 5).Value = rs!ArPrenom
             End With
          
            'IMPRIMER
            '.PrintOut
           
            'SUIVANT
            rs.MoveNext
    Loop
MsgBox "TERMINE"
'AFFICHER EXCEL
     wbExcel.Windows.Application.Visible = True

'FERMER EXCEL
   ' .Close False
 
 End With

En esperant que cela marche cette fois

A+

Merci bigfish_le vrai 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 72 internautes ce mois-ci

Commenter la réponse de bigfish_le vrai
Meilleure réponse
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 2 juil. 2008 à 11:17
3
Merci
Salut tout le monde,
voilà le code qui marche


Sub ENVOYER


'OUVRIR LA TABLE


    Dim rs As Recordset
    Set rs = pDB.OpenRecordset("INSCRIPTIONS", dbOpenDynaset)
    
   'SI LA TABLE EST VIDE
   If rs.BOF And rs.EOF Then
        MsgBox "Table vide !"
        Exit Sub
   End If


'- Ouvrir un fichier Excel
'Déclaration des variables
    Dim appExcel As Excel.Application 'Application Excel
    Dim wbExcel As Excel.Workbook 'Classeur Excel
    Dim wsExcel As Excel.Worksheet 'Feuille Excel


'Ouverture de l'application
    Set appExcel = CreateObject("Excel.Application")
  'Ouverture d'un fichier Excel
    Set wbExcel = appExcel.Workbooks.Open(App.Path & "\NXLS.xls")
 'wsExcel correspond à la première feuille du fichier
    Set wsExcel = wbExcel.Worksheets(1)


 
  rs.MoveFirst
  Dim i As Integer, y As Integer, xPage As Integer
  Dim enr As Integer  'numéro d' enregistrement
  
   y = 0
   xPage = 1
 
  'Set wsExcel = wbExcel.Worksheets(1)
 
 '<strike>With wsExcel
</strike>    Do While Not rs.EOF
    
       enr = enr + 1
            'LIRE L' ENREGISTREMENT
            'ET
            'ECRIRE DANS EXCEL
            y = y + 1
           
             If y = 13 Then
                 'REINITIALISER L'INDEX LIGNE
                 'EN VUE DE LA PROCHAINE FEUILLE
                 y = 1
              
               'AJOUTER UNE FEUILLE
               If xPage = wbExcel.Worksheets.Count Then
                 wbExcel.Worksheets.Add , wbExcel.Worksheets(xPage), 1
               End If
                 xPage = xPage + 1
             End If
             
              Set wsExcel = wbExcel.Worksheets(xPage)
         ' il faut définir le blocWith
         'après avoir référencer l' objet
      
       With wsExcel
             Debug.Print .Name
            .Activate
         
           'PAGE ACTIVE


            .Cells(y, 1) = rs!Nom
            .Cells(y, 2) = rs!Prenom
            .Cells(y, 3) = rs!Ne_le
            .Cells(y, 4) = rs!ArNom
            .Cells(y, 5) = rs!ArPrenom
           
            .Cells(y, 7) = enr
           .Cells(y, 8) = rs.RecordCount
           
         End With
            'ENREGISTREMENT SUIVANT
            rs.MoveNext
        
    Loop
With wsExcel
  MsgBox "TERMINE"
 
 'IMPRIMER
     '.PrintOut
 
 'AFFICHER EXCEL
      wbExcel.Windows.Application.Visible = True


'FERMER EXCEL
   ' .Close False
End With


'...DETRUIRE LES OBJETS
    Set appExcel = Nothing
    Set wbExcel = Nothing
    Set wsExcel = Nothing
   
    MsgBox " Objet fermé"


'Fermer et détruire l' objet recordset
    rs.Close
    Set rs = Nothing


End Sub

ce qui m' a mis la puce à l' oreille c' est le Debug.Print .Name.
Dans l' ancien code, il affichait toujours Feuill1.

Merci à tous.

:





<hr />... Y'en a même qui disent qu'ils l'ont vu voler.

Merci LIBRE_MAX 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 72 internautes ce mois-ci

Commenter la réponse de LIBRE_MAX
PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention - 1 juil. 2008 à 19:11
0
Merci
^^
déplacé de VBA vers VB6
(j'crois que c'est la première fois, pour moi en tout cas)
Commenter la réponse de PCPT
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 19:18
0
Merci
je me doutais bien que je suis trompé de rubrique.

En tout cas, problème résolu en ce qui concerne
l' ordre des sheets.
Un argument mal placé , comme ma question :)
Il fallait mettre
'AJOUTER UNE FEUILLE
   wbExcel.Worksheets.Add , xPage, 1

xPage en deuxième position .Ce qui correspond à After.
Reste l' optimisation du code.
Je compte sur les Eperts.Ils se reconnaiteront.
Merci

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention - 1 juil. 2008 à 19:32
0
Merci
avec excel..., pas dans le lot

peut-être un .Application.ScreenUpdating = False sous le WITH , et True en sortie

ton .Cells(y, 3) prend 3 valeurs, peut-être ne garder que la 3e (à moins que çà soit juste pour des tests...)

un petit rs.close et set rs = nothing en sortie

sinon à première vue çà semble correct
Commenter la réponse de PCPT
PCPT 13368 Messages postés lundi 13 décembre 2004Date d'inscription 3 février 2018 Dernière intervention - 1 juil. 2008 à 19:34
0
Merci
et si on doit passer par le .activate, tu peux supprimer le 1er et descendre le 2e de 2 lignes
Commenter la réponse de PCPT
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 19:51
0
Merci
...avec excel..., pas dans le lot
On est au moins deux

...Efectivement
 .Cells(y, 1) = rs!Nom
 .Cells(y, 2) = rs!Prenom
 .Cells(y, 3) = rs!Ne_le
 .Cells(y, 4) = rs!ArNom
 .Cells(y, 5) = rs!ArPrenom

j' ai fait un copier/coller sur la 3 ligne
et j' ai omis de changer l' index .

...un petit rs.close et set rs = nothing en sortie
Accordé !

Peut être aussi déplacer 
'IMPRIMER
  '.PrintOut

vers
If y = 12 Then  
'>> en pensant bien sûr à l' activer

Pour le
peut-être un .Application.ScreenUpdating = False sous le WITH, et True en sortie

Peut être..

J' ai pensé à
'AFFICHER EXCEL
     wbExcel.Windows.Application.Visible = True

pour ouvrir directement Excel et constater les modifs.

En tout cas compte tenu de tes remarques, c' est un bn début

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 20:03
0
Merci
Passer le problème de l' ordre, je viens de constater
que seule la première feuille est remplie.
Même en déplaçant le .Activate , comme suggèré.
T' as bien mis le doigt dessus.. Reste à trouver ou le caser.




 





<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 1 juil. 2008 à 20:16
0
Merci
Salut,

moi je ferai bien un truc comme ça :

les modif en bleu et rouge

  With wbExcel
     .Activate
    Do While Not rs.EOF
            'LIRE L' ENREGISTREMENT
            'ET
            'ECRIRE DANS EXCEL
            y = y + 1
    
           'pour avoir 12 lignes par page
             If y = 12 Then  
               If xPage = .Worksheets.Count Then
                 'AJOUTER UNE FEUILLE
                  .Worksheets.Add , xPage, 1
               End If
                 xPage = xPage + 1
                
                 'ACTIVER LA DERNIERE PAGE
                 Set wsExcel = wbExcel.Worksheets(xPage).Activate <--- a suprimer
                y = 1
             End If
            with .Worksheets(.Worksheets.Count) 'ici tu sera toujours certain de travailler sur la derniere
                .Cells(y, 1) = rs!Nom
                .Cells(y, 2) = rs!Prenom
                .Cells(y, 3) = rs!Ne_le
                .Cells(y, 4) = rs!ArNom
                .Cells(y, 5) = rs!ArPrenom
             End With
         
            'IMPRIMER
            '.PrintOut
           
            'SUIVANT
            rs.MoveNext
    Loop
MsgBox "TERMINE" 'AFFICHER EXCEL
     wbExcel.Windows.Application.Visible = True

'FERMER EXCEL
   ' .Close False
 
 End With
Commenter la réponse de bigfish_le vrai
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 20:47
0
Merci
Salut bigfish_levrai,


Je ne sais pas pourquoi mais avec ce que tu
préconises, les données se retrouvent tous à
la dernière page (24 pour être précis)
Alors ne prend t-il pas en compte que les
derniers ?
J' ai rajouter un compteur, et
.Cells(y,7)=enr


et enr prend les valeurs des 12 derniers.
Les autres pages sont vides.



<hr />


... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 1 juil. 2008 à 21:29
0
Merci
Comprend pas !!!
La condition if y= 12 oblige excel ecrire sur douze ligne avant de creer une page... comment peut il creer les page ecrire apres ?!?!?

Ah oui ! compris
             If y 12 Then   'si y 12 on doit changer de page
               If xPage = .Worksheets.Count Then 'si on est a la derniere page deja existante
                 'AJOUTER UNE FEUILLE
                  .Worksheets.Add , xPage, 1
               Else 'si un certain nombre de page existe deja on passe a la suivante
                   xPage = xPage + 1
               End If
                y = 1
             End If
            with .Worksheets(xPage)
                .Cells(y, 1).Value = rs!Nom
                .Cells(y, 2).Value = rs!Prenom
                .Cells(y, 3).Value = rs!Ne_le
                .Cells(y, 4).Value = rs!ArNom
                .Cells(y, 5).Value = rs!ArPrenom
             End With

cela devrait aller mieux... je doit dire que j'ai zapper le cas des feuilles deja existantes
Commenter la réponse de bigfish_le vrai
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 21:37
0
Merci
Ajouter à cela, pour plus de précision, qu' étant donné
que le nombre depage d' un classeur est par défaut à 3,
If xPage = .Worksheets.Count me renseigne si je suis arrivé
à la 3° ou pas.Si oui j' ajoute une, sinon je passe à la suivante (la 2 puis la 3).
Ce qui fait que je commence à rajouter à partir de la 3°.

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 21:42
0
Merci
En fait c' est if y=13 Then
 pour être dans le vrai  et y rester bien sûr..

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 1 juil. 2008 à 21:43
0
Merci
et ?... tu nous a pas dis ! ça fonctionne ou pas ?
Commenter la réponse de bigfish_le vrai
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 21:47
0
Merci
Pas encore !
Panne sèche
Rassurz moi au moins :
Le fait qu' il n' y ait plus de réponse n' a rien avoir avec le prix du petrol ?

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 1 juil. 2008 à 21:52
0
Merci
Ben moi je t'ai repondu !!! tien je te la redonne cette reponse :



Comprend pas !!!
La
condition if y=12 oblige excel ecrire sur douze ligne avant de creer
une page... comment peut il creer les page ecrire apres ?!?!?

Ah oui ! compris
             If y 12 Then   'si y 12 on doit changer de page
               If xPage = .Worksheets.Count Then 'si on est a la derniere page deja existante
                 'AJOUTER UNE FEUILLE
                  .Worksheets.Add , xPage, 1
               Else 'si un certain nombre de page existe deja on passe a la suivante
                   xPage = xPage + 1
               End If
                y = 1
             End If
            with .Worksheets(xPage)
                .Cells(y, 1).Value = rs!Nom
                .Cells(y, 2).Value = rs!Prenom
                .Cells(y, 3).Value = rs!Ne_le
                .Cells(y, 4).Value = rs!ArNom
                .Cells(y, 5).Value = rs!ArPrenom
             End With

cela devrait aller mieux... je doit dire que j'ai zapper le cas des feuilles deja existantes
Commenter la réponse de bigfish_le vrai
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 21:56
0
Merci
mais non ! je plaisantait
c' était un clin d' oeil !

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 22:10
0
Merci
Au fait ,
il y a erreur sur le  with .Worksheets(xPage)
Le .WorkSheets doit se réfèrer à wbExcel et non à wsExcel (Imbrication des With, voir With plus haut)
Avec with wbExcel.Worksheets(xPage), seule la dernière page est remplie.

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX
LIBRE_MAX 1403 Messages postés mardi 1 mai 2007Date d'inscription 7 octobre 2012 Dernière intervention - 1 juil. 2008 à 22:22
0
Merci
j' ai 280 enregistrements.
280 / 12 = 13,33
ce qui correspond à 24 pages.
Et c' exactement le nombre depages que j' ai au final.
C' est dire que la logique est respectée.
Reste à savoir pourquoi 23 pages sur 24 sont vides !
Je suis sûr que le problème vient de l' activation de la page courante .

<hr />... Y'en a même qui disent qu'ils l'ont vu voler.
Commenter la réponse de LIBRE_MAX

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.