[RESOLU] Acc. 2000 Export XL : contourner la limite de 255 caractères

Acc. 2000 Export XL : contourner la limite de 255 caractères [RESOLU] - VB/VBA/VBS - Programmation

Marsh Posté le 04-08-2009 à 11:47:50    

Bonjour à tous,  
 
J'ai un petit soucis (si si ^^) sous access 2000.
J'ai une application qui permet d'extraire des données avec la méthode outputTo.
Ca, ca marche niquel.
 
Maintenant, j'ai une demande d'évolution afin de permettre de remplir +255 caracteres sur les champs, et surtout de pouvoir l'exporter ce champ texte (donc passer d'un champ texte simple à un mémo).
 
J'ai cherché un peu partout, sous access 2000, c'est pas possible directement (apparemment parce que c'est calqué sur un modèle d'export d'access 95 qui ne permettait pas cela)
 
J'ai donc trouvé une parade sur le site de microsoft qui consiste à recomposer le mémo sur la feuille excel

Code :
  1. texte = rec.Fields("DESCRIPTIF" )
  2. 'on le met dans les cellules correspondantes
  3. xlSheet.Cells(I, 27) = Mid([texte], 1, 250)
  4. xlSheet.Cells(I, 28) = Mid([texte], 251, 250)
  5. xlSheet.Cells(I, 29) = Mid([texte], 501, 250)
  6. 'on le reconstitue
  7. xlSheet.Cells(I, 2) = xlSheet.Cells(I, 27) & xlSheet.Cells(I, 28) & xlSheet.Cells(I, 29)


 
Si je parcours ma table, et que j'exporte bêtement, ca marche niquel :  

Code :
  1. Function TransfertExcelAutomation()
  3.     Dim xlApp As Excel.Application
  4.     Dim xlSheet As Excel.Worksheet
  5.     Dim xlBook As Excel.Workbook
  6.     Dim I As Long, J As Long
  7.     Dim texte As String
  8.     Dim lng As Integer
  9.     Dim valeur As String
  10.    
  11.     Dim rec As DAO.Recordset
  12.    
  13.     Set rec = CurrentDb.OpenRecordset("tblDocument" )
  14.    
  15.     'Initialisations
  16.     Set xlApp = CreateObject("Excel.Application" )
  17.     Set xlBook = xlApp.Workbooks.Add
  18.  
  19.     'Ajouter une feuille de calcul
  20.     Set xlSheet = xlBook.Worksheets.Add
  21.     xlSheet.name = "Tutoriel"
  22.  
  23.     ' le titre
  24.     '  écriture dans la cellule de ligne 1 et de colonne 1
  25.     xlSheet.Cells(1, 1) = "Export d'une table Access"
  26.  
  27.    
  28.     ' les entetes
  29.     '  .Fields(Index).Name renvoie le nom du champ
  30.     For J = 0 To rec.Fields.Count - 1
  31.         xlSheet.Cells(2, J + 1) = rec.Fields(J).name
  32.         ' Nous appliquons des enrichissements de format aux cellules
  33.         With xlSheet.Cells(2, J + 1)
  34.             .Interior.ColorIndex = 15
  35.             .Interior.Pattern = xlSolid
  36.             .Borders(xlEdgeBottom).LineStyle = xlContinuous
  37.             .Borders(xlEdgeBottom).Weight = xlThin
  38.             .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
  39.             .HorizontalAlignment = xlCenter
  40.         End With
  41.     Next J
  42.     xlSheet.Cells(2, 27) = "memo1"
  43.     xlSheet.Cells(2, 28) = "memo2"
  44.     xlSheet.Cells(2, 29) = "memo3"
  45.    
  46.     ' recopie des données à partir de la ligne 3
  47.     I = 3
  48.     Do While Not rec.EOF
  49.         For J = 0 To rec.Fields.Count - 1
  50.             xlSheet.Cells(I, J + 1) = rec.Fields(J)
  51.            
  52.             If rec.Fields(J).name = "DESCRIPTIF" Then
  53.                 If (Not IsNull(rec.Fields(J))) Then
  54.                     lng = Len(rec.Fields(J))
  55.                     If (lng > 255) Then
  56.                         texte = rec.Fields(J)
  57.                         lng = Len(texte)
  58.                         MsgBox (texte & " " & lng)
  59.                         xlSheet.Cells(I, 27) = Mid([texte], 1, 250)
  60.                         xlSheet.Cells(I, 28) = Mid([texte], 251, 250)
  61.                         xlSheet.Cells(I, 29) = Mid([texte], 501, 250)
  62.                         xlSheet.Cells(I, 3) = xlSheet.Cells(I, 27) & xlSheet.Cells(I, 28) & xlSheet.Cells(I, 29)
  63.                     End If
  64.                 End If
  65.             End If
  66.            
  67.         Next J
  68.         I = I + 1
  69.         rec.MoveNext
  70.     Loop
  71.  
  72.     ' code de fermeture et libération des objets
  73.     xlBook.SaveAs "C:\Documents and Settings\LHERMEN\Bureau\TestMemo.xls"
  74.     xlApp.Quit
  75.     rec.Close
  76.     Set rec = Nothing
  77.     Set xlSheet = Nothing
  78.     Set xlBook = Nothing
  79.     Set xlApp = Nothing
  80. End Function


 
Maintenant, lorsque je veux comparer un champ de ma table avec un champ d'une feuille excel (sur laquelle j'exporte) pour avoir le bon descriptif à la bonne ligne,  
ca ne marche plus...il ne récupère plus après 255 caractères.
Voilà le code correspondant (donc j'ai exporté toutes mes lignes avec outputTo, et ensuite je parcours la colonne Id_document pour récupérer les mémos de + 255 caracteres) :  
 

Code :
  1. Private Sub cmdExporter_Click()
  2. On Error GoTo Err_cmdExporter_Click
  4.     Dim stDocName As String
  5.     Dim stDir As String
  6.     Dim name As String
  7.    
  8.    
  9.     stDocName = "etat_Rapport"
  10.     stDir = "C:/"
  11.     DoCmd.OutputTo acReport, stDocName
  12.    
  13.     Dim xlApp As Excel.Application
  14.     Dim xlSheet As Excel.Worksheet
  15.     Dim xlBook As Excel.Workbook
  16.     Dim I As Long, J As Long
  17.     Dim texte, id As String
  18.     Dim lng As Integer
  20.     Dim rec As DAO.Recordset
  22.     'Initialisations
  23.     Set xlApp = CreateObject("Excel.Application" )
  26.     name = stDir & stDocName & ".xls"
  27.     Set xlBook = xlApp.Workbooks.Open(name)
  28.     Set xlSheet = xlBook.Sheets("etat_Rapport" )
  29.    
  30.     'on initialise les 3 colonnes nécessaires pour reconstituer le mémo
  31.     xlSheet.Cells(2, 27) = "memo1"
  32.     xlSheet.Cells(2, 28) = "memo2"
  33.     xlSheet.Cells(2, 29) = "memo3"
  34.    
  35.     I = 3
  36.    
  37.     'on parcourt la colonne B (ID_DOCUMENT), en commencant à la 3e ligne
  38.     'tant que la colonne n'a pas de valeur nulle
  39.     While Not xlSheet.Range("B" & I & "" ).Value = ""
  40.         'on recupere la valeur de ID_DOCUMENT
  41.         id = xlSheet.Range("B" & I).Value
  42.         'on ouvre le recordset
  43.         Set rec = CurrentDb.OpenRecordset("qryGet_Rapport" )
  44.         'tant qu'il y a des lignes dans le recordset
  45.         Do While Not rec.EOF
  46.             'si l'id dans le doc et l'id du recordset correspondent (on a la bonne ligne)
  47.             If (rec.Fields("ID_DOCUMENT" ).Value = id) Then
  48.                         'on recupere le mémo
  49.                         texte = rec.Fields("DESCRIPTIF" )
  50.                         'on affiche le texte si supérieur a 254
  51.                         If Len(texte) > 255 Then
  52.                             MsgBox texte & " - " & Len(texte)
  53.                         End If
  54.                         'on le met dans les cellules correspondantes
  55.                         'xlSheet.Cells(I, 27) = Mid([texte], 1, 250)
  56.                         'xlSheet.Cells(I, 28) = Mid([texte], 251, 250)
  57.                         'xlSheet.Cells(I, 29) = Mid([texte], 501, 250)
  58.                         xlSheet.Cells(I, 27) = Mid([texte], 1, 250)
  59.                         xlSheet.Cells(I, 27) = xlSheet.Cells(I, 27) & Mid([texte], 251, 250)
  60.                         xlSheet.Cells(I, 27) = xlSheet.Cells(I, 27) & Mid([texte], 501, 250)
  62.                         'on le reconstitue
  63.                         'xlSheet.Cells(I, 2) = "coucou" 'xlSheet.Cells(I, 27) & xlSheet.Cells(I, 28) & xlSheet.Cells(I, 29)
  64.                         'TODO : supprimer la colonne B
  65.                         texte = ""
  66.             End If
  67.             rec.MoveNext
  68.         Loop
  69.         rec.Close
  70.         I = I + 1
  71.     Wend
  74.       xlBook.SaveAs filename:=name
  77.     xlApp.Quit
  78.     Set rec = Nothing
  79.     Set xlSheet = Nothing
  80.     Set xlBook = Nothing
  81.     Set xlApp = Nothing
  83.    
  85. Exit_cmdExporter_Click:
  86.     Exit Sub
  88. Err_cmdExporter_Click:
  89.     MsgBox Err.Description
  90.     xlApp.Quit
  91.     rec.Close
  92.     Set rec = Nothing
  93.     Set xlSheet = Nothing
  94.     Set xlBook = Nothing
  95.     Set xlApp = Nothing
  96.     Resume Exit_cmdExporter_Click
  97.    
  98. End Sub


 
Qqun aurait une idée sur le pourquoi ?


Message édité par gocho le 05-08-2009 à 14:06:35
Reply

Marsh Posté le 04-08-2009 à 11:47:50   

Reply

Marsh Posté le 04-08-2009 à 16:32:22    

personne n'aurait une petite idée ?  
 
bon, j'passerais bien à Access 2003 ou +, ca ferait sauter le problème, mais bon, en entreprise.... :/

Reply

Marsh Posté le 05-08-2009 à 09:41:21    

bonjour
Désolé si ma question te parait bête mais pourquoi ne pas faire

Code :
  1. xlSheet.Cells(I, 2) = Mid([texte], 1, 250)
  2. xlSheet.Cells(I, 2) = xlSheet.Cells(I, 2) & Mid([texte], 251, 250)
  3. xlSheet.Cells(I, 2) = xlSheet.Cells(I, 2) & Mid([texte], 501, 250)


Ca t'éviterait d'avoir à reconstituer non?

Code :
  1. xlSheet.Cells(I, 27) = Mid([texte], 1, 250)
  2. xlSheet.Cells(I, 28) = Mid([texte], 251, 250)
  3. xlSheet.Cells(I, 29) = Mid([texte], 501, 250)
  4. 'on le reconstitue
  5. xlSheet.Cells(I, 2) = xlSheet.Cells(I, 27) & xlSheet.Cells(I, 28) & xlSheet.Cells(I, 29)


 
Aussi je suis surpris par cette ligne :heink:  

Code :
  1. xlSheet.Cells(I, 29) = Mid([texte], 501, 250)


C'est pas plutôt  :D  

Code :
  1. xlSheet.Cells(I, 29) = Mid([texte], 501, 750)


ca donnerait  

Code :
  1. xlSheet.Cells(I, 2) = Mid([texte], 1, 250)
  2. xlSheet.Cells(I, 2) = xlSheet.Cells(I, 2) & Mid([texte], 251, 250)
  3. xlSheet.Cells(I, 2) = xlSheet.Cells(I, 2) & Mid([texte], 501, 750)


a condition que tes chaînes de caractère ne fasse pas plus de 750 caractères


Message édité par _xme_ le 05-08-2009 à 09:42:54
Reply

Marsh Posté le 05-08-2009 à 10:19:49    

j'ai pas pensé à reconstituer au fur et à mesure, j'vais tester, si jamais ca pouvait marcher :)
 
par contre, pour  

Code :
  1. xlSheet.Cells(I, 29) = Mid([texte], 501, 750)


 
le derniere paramètre représente le nombre de caractères.
donc prendre à partir du caractère 501, et sur 250 caractères :)

Message cité 1 fois
Message édité par gocho le 05-08-2009 à 10:20:06
Reply

Marsh Posté le 05-08-2009 à 11:09:08    

gocho a écrit :


Code :
  1. xlSheet.Cells(I, 29) = Mid([texte], 501, 750)


 
le derniere paramètre représente le nombre de caractères.
donc prendre à partir du caractère 501, et sur 250 caractères :)


aaaaaaaa  :whistle:  
Ben j'aurais appris un truc comme ça ^^
alors ca marche la reconstitution au fur et à mesure?


Message édité par _xme_ le 05-08-2009 à 11:09:47
Reply

Marsh Posté le 05-08-2009 à 11:18:59    

non, rien à faire, ca ne veut pas :'(
 
je comprends pas du tout ce comportement ...

Reply

Marsh Posté le 05-08-2009 à 11:31:51    

as-tu essayé de détaillé le comportement à coup de msgbox?
du genre

Code :
  1. I = 3
  2. Do While Not rec.EOF
  3.      For J = 0 To rec.Fields.Count - 1
  4.          If rec.Fields(J).name = "DESCRIPTIF" Then
  5.              If (Not IsNull(rec.Fields(J))) Then
  6.                  lng = Len(rec.Fields(J))
  7.                  If (lng > 100) Then
  8.                      texte = rec.Fields(J)         
  9.                      Msgbox texte
  10.                      Msgbox xlSheet.Cells(I, 2)
  11.                      xlSheet.Cells(I, 2) = xlSheet.Cells(I, 2) & Mid([texte], 1, 250)
  12.                      Msgbox xlSheet.Cells(I, 2)
  13.                      xlSheet.Cells(I, 2) = xlSheet.Cells(I, 2) & Mid([texte], 251, 250)
  14.                      Msgbox xlSheet.Cells(I, 2)
  15.                      xlSheet.Cells(I, 2) = xlSheet.Cells(I, 2) & Mid([texte], 501, 250)
  16.                      Msgbox xlSheet.Cells(I, 2)
  17.                  End If
  18.              End If
  19.          End If
  20.        Next J
  21.       I = I + 1
  22.       rec.MoveNext
  23. Loop


et

Code :
  1. I = 3
  2. 'on parcourt la colonne B (ID_DOCUMENT), en commencant à la 3e ligne
  3. 'tant que la colonne n'a pas de valeur nulle
  4. While Not xlSheet.Range("B" & I & "" ).Value = ""
  5.     'on recupere la valeur de ID_DOCUMENT
  6.     id = xlSheet.Range("B" & I).Value
  7.     'on ouvre le recordset
  8.     Set rec = CurrentDb.OpenRecordset("qryGet_Rapport" )
  9.     tant qu'il y a des lignes dans le recordset
  10.         Do While Not rec.EOF
  11.         si l'id dans le doc et l'id du recordset correspondent (on a la bonne ligne)
  12.         If (rec.Fields("ID_DOCUMENT" ).Value = id) Then
  13.                     'on recupere le mémo
  14.                      texte = rec.Fields("DESCRIPTIF" )
  15.                     'on le met dans les cellules correspondantes
  16.                      Msgbox texte 
  17.                      Msgbox xlSheet.Cells(I, 2)
  18.                      xlSheet.Cells(I, 2) = xlSheet.Cells(I, 2) & Mid([texte], 1, 250)
  19.                      Msgbox xlSheet.Cells(I, 2)
  20.                      xlSheet.Cells(I, 2) = xlSheet.Cells(I, 2) & Mid([texte], 251, 250)
  21.                      Msgbox xlSheet.Cells(I, 2)
  22.                      xlSheet.Cells(I, 2) = xlSheet.Cells(I, 2) & Mid([texte], 501, 250)
  23.                      Msgbox xlSheet.Cells(I, 2)
  24.         End If
  25.         rec.MoveNext
  26.     Loop
  27.     rec.Close
  28.     I = I + 1
  29. Wend


histoire de voir un peu étape par étape
que ce passe-t-il pour l'instant précisémment?
Car là comme ça tes 2 codes m'ont l'air très similaire et je vois aucune anomalie :sweat:


Message édité par _xme_ le 05-08-2009 à 11:33:51
Reply

Marsh Posté le 05-08-2009 à 11:37:24    

je n'ai pas détaillé chaque ligne comme ca (mon doc faisant 300 lignes, 3 msgbox par ligne, euh... ^^)
 
mais j'ai ajouté ca avant la séparation du texte :  

Code :
  1. If Len(texte) > 254 Then
  2.         MsgBox texte & " - " & len(texte)
  3. End If


 
Dans le premier cas, j'obtiens : "mon texte en entier - 296 caractères" --> ok
Dans le second cas, j'obtiens : "mon texte coupé - 255 caractères" --> :'(


Message édité par gocho le 05-08-2009 à 11:41:52
Reply

Marsh Posté le 05-08-2009 à 11:51:01    

Petit joueur, j'ai déjà détaillé pire que ça en utilisant access et ma base de donnée avait 9000 entrées qui m'interessaient  :pt1cable:  :D  .
Bon après je passais 5 min sur la touche enter, une fois que j'avais trouvé mon problème :D
 
Bon donc dans le premier cas la reconstitution au fur et à mesure ca marche?
Dans ce cas et d'après ton test il semble que ca viennent dès ton reccordset donc le soucis ne serait pas excel mais ton reccordset.
As-tu vériffié si un recordset support les chaines de plus de 255 caractères car si c'est pas le cas, c'est la merde ^^. cf doc petit recherche google necessaire
As tu vérifié que dans la base de données tu as bien des chaines de plus de 255 caractères, histoire que t'ai pas déclaré ton champs en varchar :D

Reply

Marsh Posté le 05-08-2009 à 12:06:59    

oui, effectivement, les 5 mn c'est ca que je trouve chiant à la fin ^^
 
Non, le premier cas marche complètement, j'ai pas détaillé.
Il me retourne bien tout mon champ qui fait 296 caracteres (et donc à priori plus de 255  :D )
 
Le recordset n'est donc à priori pas en cause, vu que je le créé de la meme facon.
 
Et dans ma base, j'ai bien un champ de +255 caractères :)
 
Mon premier code fonctionne, pas le 2e.

Message cité 1 fois
Reply

Marsh Posté le 05-08-2009 à 12:06:59   

Reply

Marsh Posté le 05-08-2009 à 12:23:04    

gocho a écrit :

oui, effectivement, les 5 mn c'est ca que je trouve chiant à la fin ^^


Patience et longueur de temps. Font plus que force ni que rage :D  

gocho a écrit :


Le recordset n'est donc à priori pas en cause, vu que je le créé de la meme facon.


Pas bien compris  :sweat:  
Pourrais-tu montrer comment tu fais ton reccord set.  

gocho a écrit :


Et dans ma base, j'ai bien un champ de +255 caractères :)


Alors là je comprends plus très bien. Si dans ta base tes champs font bien plus de 255 caractères, tu n'as pas besoin de recomposer ton reccordset  :??:  
Si c'est un reccordset qui provient directement d'une requete sql, pourrais-tu vérifié la sortie
Vérifié que tu as bien 255 cractères.
Etant donné que je ne connais pas ton script, je suis obligé de faire pas mal de supposition, du coup des détails sur l'exécution c'est pratique :)
 

Reply

Marsh Posté le 05-08-2009 à 13:10:02    

bon, histoire de faire simple, j'ai changé le premier post en mettant mes deux fonctions dans leur ensemble.
La premiere (transferExcelAutomation) est celle qui marche. Je récupère bien mes champs avec tous leurs caractères.
 
La seconde est celle qui pose problème.
 
Comme ca, ca devrait être plus compréhensible :)
 
 
edit : bourdel ! mais pourquoi le recordset n'est plus ouvert à partir de la même chose !  
Je sens que je vais modifier la seconde fonction en ouvrant à partir de la table et non d'une requête, m'apercevoir que ca fonctionne et aller me pendre :-/


Message édité par gocho le 05-08-2009 à 13:11:58
Reply

Marsh Posté le 05-08-2009 à 13:17:44    

[:haha dead] [:kosmos]  
 
ptin mais pourquoi une requete ne récupère pas plus de 255 caractères....
 
ca marche \o/
 
merci _xme_  :)
j'pense que j'aurais jamais pensé à vérifier ca, quel con lol
 
Ceci dit, la reconstitution dans une seule cellule ne fonctionne pas :-/
Ca me garde que la premiere partie.

Reply

Marsh Posté le 05-08-2009 à 13:41:18    

Du moment que ca marche osef  :D  
bon ben tant mieux  
bonne journée

Reply

Sujets relatifs:

Leave a Replay

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