gocho | 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 :
- texte = rec.Fields("DESCRIPTIF" )
- 'on le met dans les cellules correspondantes
- xlSheet.Cells(I, 27) = Mid([texte], 1, 250)
- xlSheet.Cells(I, 28) = Mid([texte], 251, 250)
- xlSheet.Cells(I, 29) = Mid([texte], 501, 250)
- 'on le reconstitue
- 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 :
- Function TransfertExcelAutomation()
- Dim xlApp As Excel.Application
- Dim xlSheet As Excel.Worksheet
- Dim xlBook As Excel.Workbook
- Dim I As Long, J As Long
- Dim texte As String
- Dim lng As Integer
- Dim valeur As String
-
- Dim rec As DAO.Recordset
-
- Set rec = CurrentDb.OpenRecordset("tblDocument" )
-
- 'Initialisations
- Set xlApp = CreateObject("Excel.Application" )
- Set xlBook = xlApp.Workbooks.Add
-
- 'Ajouter une feuille de calcul
- Set xlSheet = xlBook.Worksheets.Add
- xlSheet.name = "Tutoriel"
-
- ' le titre
- ' écriture dans la cellule de ligne 1 et de colonne 1
- xlSheet.Cells(1, 1) = "Export d'une table Access"
-
-
- ' les entetes
- ' .Fields(Index).Name renvoie le nom du champ
- For J = 0 To rec.Fields.Count - 1
- xlSheet.Cells(2, J + 1) = rec.Fields(J).name
- ' Nous appliquons des enrichissements de format aux cellules
- With xlSheet.Cells(2, J + 1)
- .Interior.ColorIndex = 15
- .Interior.Pattern = xlSolid
- .Borders(xlEdgeBottom).LineStyle = xlContinuous
- .Borders(xlEdgeBottom).Weight = xlThin
- .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
- .HorizontalAlignment = xlCenter
- End With
- Next J
- xlSheet.Cells(2, 27) = "memo1"
- xlSheet.Cells(2, 28) = "memo2"
- xlSheet.Cells(2, 29) = "memo3"
-
- ' recopie des données à partir de la ligne 3
- I = 3
- Do While Not rec.EOF
- For J = 0 To rec.Fields.Count - 1
- xlSheet.Cells(I, J + 1) = rec.Fields(J)
-
- If rec.Fields(J).name = "DESCRIPTIF" Then
- If (Not IsNull(rec.Fields(J))) Then
- lng = Len(rec.Fields(J))
- If (lng > 255) Then
- texte = rec.Fields(J)
- lng = Len(texte)
- MsgBox (texte & " " & lng)
- xlSheet.Cells(I, 27) = Mid([texte], 1, 250)
- xlSheet.Cells(I, 28) = Mid([texte], 251, 250)
- xlSheet.Cells(I, 29) = Mid([texte], 501, 250)
- xlSheet.Cells(I, 3) = xlSheet.Cells(I, 27) & xlSheet.Cells(I, 28) & xlSheet.Cells(I, 29)
- End If
- End If
- End If
-
- Next J
- I = I + 1
- rec.MoveNext
- Loop
-
- ' code de fermeture et libération des objets
- xlBook.SaveAs "C:\Documents and Settings\LHERMEN\Bureau\TestMemo.xls"
- xlApp.Quit
- rec.Close
- Set rec = Nothing
- Set xlSheet = Nothing
- Set xlBook = Nothing
- Set xlApp = Nothing
- 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 :
- Private Sub cmdExporter_Click()
- On Error GoTo Err_cmdExporter_Click
- Dim stDocName As String
- Dim stDir As String
- Dim name As String
-
-
- stDocName = "etat_Rapport"
- stDir = "C:/"
- DoCmd.OutputTo acReport, stDocName
-
- Dim xlApp As Excel.Application
- Dim xlSheet As Excel.Worksheet
- Dim xlBook As Excel.Workbook
- Dim I As Long, J As Long
- Dim texte, id As String
- Dim lng As Integer
- Dim rec As DAO.Recordset
- 'Initialisations
- Set xlApp = CreateObject("Excel.Application" )
- name = stDir & stDocName & ".xls"
- Set xlBook = xlApp.Workbooks.Open(name)
- Set xlSheet = xlBook.Sheets("etat_Rapport" )
-
- 'on initialise les 3 colonnes nécessaires pour reconstituer le mémo
- xlSheet.Cells(2, 27) = "memo1"
- xlSheet.Cells(2, 28) = "memo2"
- xlSheet.Cells(2, 29) = "memo3"
-
- I = 3
-
- 'on parcourt la colonne B (ID_DOCUMENT), en commencant à la 3e ligne
- 'tant que la colonne n'a pas de valeur nulle
- While Not xlSheet.Range("B" & I & "" ).Value = ""
- 'on recupere la valeur de ID_DOCUMENT
- id = xlSheet.Range("B" & I).Value
- 'on ouvre le recordset
- Set rec = CurrentDb.OpenRecordset("qryGet_Rapport" )
- 'tant qu'il y a des lignes dans le recordset
- Do While Not rec.EOF
- 'si l'id dans le doc et l'id du recordset correspondent (on a la bonne ligne)
- If (rec.Fields("ID_DOCUMENT" ).Value = id) Then
- 'on recupere le mémo
- texte = rec.Fields("DESCRIPTIF" )
- 'on affiche le texte si supérieur a 254
- If Len(texte) > 255 Then
- MsgBox texte & " - " & Len(texte)
- End If
- 'on le met dans les cellules correspondantes
- 'xlSheet.Cells(I, 27) = Mid([texte], 1, 250)
- 'xlSheet.Cells(I, 28) = Mid([texte], 251, 250)
- 'xlSheet.Cells(I, 29) = Mid([texte], 501, 250)
- xlSheet.Cells(I, 27) = Mid([texte], 1, 250)
- xlSheet.Cells(I, 27) = xlSheet.Cells(I, 27) & Mid([texte], 251, 250)
- xlSheet.Cells(I, 27) = xlSheet.Cells(I, 27) & Mid([texte], 501, 250)
- 'on le reconstitue
- 'xlSheet.Cells(I, 2) = "coucou" 'xlSheet.Cells(I, 27) & xlSheet.Cells(I, 28) & xlSheet.Cells(I, 29)
- 'TODO : supprimer la colonne B
- texte = ""
- End If
- rec.MoveNext
- Loop
- rec.Close
- I = I + 1
- Wend
- xlBook.SaveAs filename:=name
- xlApp.Quit
- Set rec = Nothing
- Set xlSheet = Nothing
- Set xlBook = Nothing
- Set xlApp = Nothing
-
- Exit_cmdExporter_Click:
- Exit Sub
- Err_cmdExporter_Click:
- MsgBox Err.Description
- xlApp.Quit
- rec.Close
- Set rec = Nothing
- Set xlSheet = Nothing
- Set xlBook = Nothing
- Set xlApp = Nothing
- Resume Exit_cmdExporter_Click
-
- End Sub
|
Qqun aurait une idée sur le pourquoi ? Message édité par gocho le 05-08-2009 à 14:06:35
|