Importer une données balisé dans excel

Importer une données balisé dans excel - VB/VBA/VBS - Programmation

Marsh Posté le 23-05-2016 à 10:10:42    

Bonjour,
 
mon problème :
 
Je veux prendre des données balisé dans des fichier cxf (c'est un fichier xml enfin c'est ce que dit la premiere ligne du fichier).
les données que je veux copier sont des nombres balisé de ce genre :
<CxF:L>93.609146</CxF:L>
<CxF:A>-1.013309</CxF:A>
<CxF:B>0.977731</CxF:B>
 
Il y aura deux fichiers, la référence et l'échantillon.
Ces informations peuvent être répétées plusieurs fois avec des nombres différents.
Dans ma "feuil2" je voudrais avoir toutes mes infos rassemblé dans les colonnes de A à F (A : L de référence, B : a de référence, C : b de référence, D: L de l'échantillon etc)
Avec ces nombres, je les compares avec des formules sur ma première feuille.
 
Pour l'instant je veux lire les fichiers et récupérer ces nombres.
J'ai essayé de m'inspirer du topic : http://forum.hardware.fr/hfr/Progr [...] 7924_1.htm
 
ce que j'ai fait (je m'occupe que du <CxF:L> pour l'instant) :
 

Code :
  1. Sub Bouton2_Cliquer()
  2. Dim TextLine
  3. Dim res As String
  4. Dim Apres_machin2 As Integer
  5. Open "c:\Temp\a.cxf" For Input As #1    ' Ouvre le fichier.
  6. Do While ((Not EOF(1)) And (InStr(TextLine, "</CxF:L>" ) = 0)) '''fait jusqu'à ce que le fichier est finie et que la que la string
  7.     Line Input #1, TextLine '''lit la ligne
  8.     If InStr(TextLine, "<CxF:L>" ) <> 0 Then: copie = True '''test prefixe
  9.     If InStr(TextLine, "</CxF:L>" ) <> 0 Then: copie = False '''test suffixe
  10.     If copie = True Then: res = res & Chr(13) & TextLine '''copie les données dans res
  11. Loop
  12. Close #1    ' Ferme le fichier.
  13. If res <> "" Then
  14.   res = Mid(res, 2, Len(res) - 1) 'enleve le premier saut de ligne
  15.  
  16.   tmp = res
  17. i = 1
  18. Do While tmp <> "" 'tant qu'il reste des infos, tant que tmp n'est pas vide
  19.   Emplacement_Saut_Ligne = InStr(tmp, Chr(13)) 'emplacement du chr(13)
  20.   If Emplacement_Saut_Ligne = 0 Then 'cas derniere ligne /ligne unique
  21.     Sheets("Feuil2" ).Cells(i, 1).Value = tmp
  22.     Exit Do
  23.   Else
  24.     Sheets("Feuil2" ).Cells(i, 1).Value = Left(tmp, Emplacement_Saut_Ligne - 1)
  25.     tmp = Mid(tmp, Emplacement_Saut_Ligne + 1, Len(tmp))
  26.   End If
  27.   i = i + 1
  28. Loop
  29. Else
  30.   MsgBox ("aucune info trouvée" )
  31. End If
  32. End Sub


 
Et ça fail misérablement...
En appuyant sur mon "bouton" j'ai la boite de dialogue "aucune info trouvée" qui apparaît...
 
Je crois que je me suis bien planté quelque part...  :sweat:  
Merci pour toute aide
 
EDIT :
url du lien réparé


Message édité par vicolecid le 23-05-2016 à 17:21:08
Reply

Marsh Posté le 23-05-2016 à 10:10:42   

Reply

Marsh Posté le 23-05-2016 à 11:19:55    

 
            Bonjour,
 
            merci de corriger le lien du topic plantant aussi misérablement
 
            Sinon si c'est un vrai fichier xml, effectuer une recherche sur le net pour traiter ce type de fichier, y a plein de tutoriels !
 
            Ou encore comme pour tout simple fichier texte, écrire la logique sur un papier avant de commencer à réécrire le code :
            l'actuel ayant une logique "aware" !  D'où le message …
            Pour comprendre l'erreur de conception :  suivre la progression du code en mode pas à pas via la touche F8
            tout en contrôlant le contenu de la fenêtre des Variables locales
 
            Voir aussi la fonction texte du VBA  Split  car ce n'est pas difficile avec un double Split entre les balises de début et de fin …
 

Reply

Marsh Posté le 23-05-2016 à 19:02:35    

Salut,
effectivement, au lieu de copier coller bêtement j'aurais due réfléchir un peu plus et surtout mieux lire le code...
-_-
 

Code :
  1. Sub Bouton2_Cliquer()
  2. Dim TextLine
  3. Dim Res, tmp As String
  4. Dim Tb() As String
  5. Open "c:\Temp\a.cxf" For Input As #1    ' Ouvre le fichier.
  6. Do While (Not EOF(1))  '''fait jusqu'à ce que le fichier est finie et que la que la string
  7.     Line Input #1, TextLine '''lit la ligne
  8.     If InStr(TextLine, "<CxF:L>" ) <> 0 Then: copie = True '''test prefixe
  9.     If InStr(TextLine, "</CxF:L>" ) <> 0 Then: copie = True '''test suffixe
  10.     TextLine = Replace(TextLine, "<CxF:L>", "" )
  11.     TextLine = Replace(TextLine, "</CxF:L>", "" )
  12.     If copie = True Then: Res = Res & Chr(13) & TextLine '''copie les données dans res
  13.    
  14.     copie = False
  15. Loop
  16. Close #1    ' Ferme le fichier.
  17. If Res <> "" Then
  18.   Res = Mid(Res, 2, Len(Res) - 1)   'enleve le premier saut de ligne
  19.   tmp = Res
  20. i = 1
  21. Do While tmp <> "" 'tant qu'il reste des infos''' tant que tmp n'est pas vide
  22.   Emplacement_Saut_Ligne = InStr(tmp, Chr(13)) 'emplacement du chr(13)
  23.   If Emplacement_Saut_Ligne = 0 Then 'cas derniere ligne /ligne unique
  24.     Sheets("Feuil2" ).Cells(i, 1).Value = tmp
  25.     Exit Do
  26.   Else
  27.     Sheets("Feuil2" ).Cells(i, 1).Value = Left(tmp, Emplacement_Saut_Ligne - 1)
  28.     tmp = Mid(tmp, Emplacement_Saut_Ligne + 1, Len(tmp))
  29.   End If
  30.   i = i + 1
  31. Loop
  32. Else
  33.   'MsgBox ("aucune info trouvée" )
  34. End If
  35. End Sub


 
Par contre j'ai pas utilisé split parce que j'ai eu la flemme de faire un for i de chaque case d'un tableau... o.o
Maintenant il faut que j'en fasse une fonction pour ajouter mes autres données x.x
J'ai encore du travail devant moi!!
 
Sinon je me demande s'il y a pas possibilité à optimiser un peu mon code... des suggestions?

Reply

Marsh Posté le 24-05-2016 à 12:08:43    

Bonjour,
 
j'ai un nouveau petit problème :
 

Code :
  1. Sub Bouton2_Cliquer()
  2. X = open_and_read_file(1)
  3. X = open_and_read_file(2)
  4. End Sub
  5. Function open_and_read_file(nrefsample)
  6. Dim TextLine
  7. Dim ResL, Resa, Resb, tmp As Integer
  8. Dim fileRef
  9. file = Application.GetOpenFilename()  ' récupère le chemin du fichier
  10. If file = False Then: Exit Function
  11. Open file For Input As #1
  12. Do While (Not EOF(1))  '''fait jusqu'à ce que le fichier est finie et que la que la string
  13.     Line Input #1, TextLine '''lit la ligne
  14.         If InStr(TextLine, "<CxF:L>" ) <> 0 Or InStr(TextLine, "</CxF:L>" ) <> 0 Then
  15.             TextLine = Replace(TextLine, vbTab & vbTab & vbTab & vbTab & vbTab & "<CxF:L>", "" ) 'on vire le préfixe
  16.             TextLine = Replace(TextLine, "</CxF:L>", "" ) 'on vire le suffixe
  17.             'If InStr(TextLine, vbTab) Then: TextLine = Replace(MyString,vbTab, "" )
  18.             ResL = ResL & Chr(13) & TextLine '''copie les données dans res séparé par des retour lignes
  19.         ElseIf InStr(TextLine, "<CxF:A>" ) <> 0 Or InStr(TextLine, "</CxF:a>" ) <> 0 Then
  20.             TextLine = Replace(TextLine, vbTab & vbTab & vbTab & vbTab & vbTab & "<CxF:A>", "" ) 'on vire le préfixe
  21.             TextLine = Replace(TextLine, "</CxF:A>", "" ) 'on vire le suffixe
  22.             Resa = Resa & Chr(13) & TextLine '''copie les données dans res séparé par des retour lignes
  23.         ElseIf InStr(TextLine, "<CxF:B>" ) <> 0 Or InStr(TextLine, "</CxF:b>" ) <> 0 Then
  24.             TextLine = Replace(TextLine, vbTab & vbTab & vbTab & vbTab & vbTab & "<CxF:B>", "" ) 'on vire le préfixe
  25.             TextLine = Replace(TextLine, "</CxF:B>", "" ) 'on vire le suffixe
  26.             Resb = Resb & Chr(13) & TextLine '''copie les données dans res séparé par des retour lignes
  27.         End If
  28. Loop
  29. Close 1    ' Ferme le fichier.
  30. If ResL <> "" Then
  31.   ResL = Mid(ResL, 2, Len(ResL) - 1)   'enleve le premier saut de ligne
  32.   Laoub = 1
  33.   tmp = write_worksheet(ResL, nrefsample, Laoub)
  34.   Else
  35.   MsgBox ("aucune info trouvée dans" & Laoub)
  36. End If
  37. If Resa <> "" Then
  38.   Resa = Mid(Resa, 2, Len(Resa) - 1)   'enleve le premier saut de ligne
  39.   Laoub = 2
  40.   tmp = write_worksheet(Resa, nrefsample, Laoub)
  41.   Else
  42.   MsgBox ("aucune info trouvée dans" & Laoub)
  43. End If
  44. If Resb <> "" Then
  45.   Resb = Mid(Resb, 2, Len(Resb) - 1)   'enleve le premier saut de ligne
  46.   Laoub = 3
  47.   tmp = write_worksheet(Resb, nrefsample, Laoub)
  48.   Else
  49.   MsgBox ("aucune info trouvée dans" & Laoub)
  50. End If
  51. End Function
  52. Function write_worksheet(resLaoub, nrefsample, Laoub)
  53. If nrefsample = 1 Then
  54.     j = 0
  55. Else
  56.     j = 3
  57. End If
  58. i = 2
  59. tmp = resLaoub
  60. Do While tmp <> "" ''' tant que tmp n'est pas vide
  61.   Emplacement_Saut_Ligne = InStr(tmp, Chr(13)) 'emplacement du chr(13)
  62.   If Emplacement_Saut_Ligne = 0 Then 'cas derniere ligne /ligne unique
  63.     Sheets("Datas" ).Cells(i, Laoub + j).Value = tmp
  64.     Exit Do
  65.   Else
  66.     Sheets("Datas" ).Cells(i, Laoub + j).Value = Left(tmp, Emplacement_Saut_Ligne - 1)
  67.     tmp = Mid(tmp, Emplacement_Saut_Ligne + 1, Len(tmp))
  68.   End If
  69.   i = i + 1
  70. Loop
  71. End Function


 
(Je sais c'est moche...)
 
Mon fichier xml contient des tab en amont de mon préfixe des données que je veux prendre, j'ai bien essayé d'utiliser :

Code :
  1. If InStr(TextLine, vbTab) Then: TextLine = Replace(MyString,vbTab, "" )


 
(parce que voir ecrire 5 vtab & de suite... hein... :heink: )
 
mais ça efface tout...  
ça fail misérablement...
est-ce que je l'utilise bien?
 
EDIT : corrections de fautes


Message édité par vicolecid le 24-05-2016 à 12:10:39
Reply

Marsh Posté le 24-05-2016 à 18:18:00    

 
            Pour effacer une séquence dans une chaine de caractères il n'y a pas besoin de If mais juste de la fonction  Replace
            car même si la séquence est absente de la chaine, cela ne gêne pas …
 
            Si « cela efface tout » :   - soit la chaine initiale est déjà vide (MyString dans l'exemple alors qu'il s'agit de TextLine ‼);
                                                 - soit la chaine ne contenait que la séquence à effacer …
 
            A noter : les fonctions  Join  &  Split  sont bien plus efficaces et rapides que les autres fonctions texte du VBA !
 
            Voir cet exemple
 

Reply

Sujets relatifs:

Leave a Replay

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