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