Code nouvellement modifié
j'avaisun problème de dépassement de capacités parceque je n'avais pas défini la variable c de ma boucle en variant heeiiin j'ai cherché longtemps.
j'ai modifié la macro pour mettre un fichier en entrée grâce à une fonction supplémentaire.
vous pouvez créer un fichier contenant la chaine exemple figurant dans le fichier de mon premier message.
par ailleurs, la demande de mon 2nd message tient toujours, si vous avez des suggestions
Sub decoupe_chaine_longueur_fixe()
'Cette macro affiche la valeur des champs des enregistrements figurant dans une seule chaîne de caractères.
'Les champs sont de longueur fixe et il n'existe aucun délimiteur.
Application.ScreenUpdating = False
' ¤¤¤¤¤¤¤¤¤¤ Définition de variables ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Dim r As Integer, Longueur As Integer, Longueur_cumulee As Integer, i As Integer, taille_enregistrement As Integer, nb_champs As Integer, nb_champs_cpt As Integer
Dim zone_a_lire As Worksheet, structure As Worksheet, zone_decryptee As Worksheet
Dim ligne_analysee As String
Dim chaine_a_analyser, c, arr 'variables variantes
Dim toRng As Range
' ¤¤¤¤¤¤¤¤¤¤ Définition de paramètres ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
'la variable ci-dessous contient la feuille où figure la structure d'un enregistrement de la chaîne
Set structure = Worksheets("structure")
'la variable ci-dessous (définie comme variante) contient la plage de cellules définissant les champs d'un enregistrement
arr = structure.[A1].CurrentRegion
'la variable ci-dessous contient la feuille où seront affichés les différents enregistrements
Set zone_decryptee = Worksheets("zone_decryptee")
'effacement de la plage de destination
zone_decryptee.[A3].CurrentRegion.ClearContents
'la variable ci-dessous contient la chaîne à analyser
'chaine_a_analyser = zone_a_lire.[A1]
' PASSER VOTRE FICHIER ICI
chaine_a_analyser = File2String("C:\Documents and Settings\steph\monfichier.doc")
'la variable ci-dessous contient la longueur totale d'un champ calculé à partir de leur taille renseignées dans la structure
taille_enregistrement = Application.WorksheetFunction.Sum(structure.Columns(2))
'la variable nb_champs contient le nombre de champs indiqués dans la feuille structure
'calculé en ôtant 1 pour faire extraction des étiquettes de la feuille structure
nb_champs = UBound(arr, 1) - 1
'initialisation de variables utilisées dans des boucles
i = 1
' ¤¤¤¤¤¤¤¤¤¤¤ Début des choses sérieuses ¤¤¤¤¤¤¤¤¤¤¤¤
For c = 1 To Len(chaine_a_analyser) Step taille_enregistrement
'Récupération d'un enregistrement
ligne_analysee = Mid(chaine_a_analyser, c, taille_enregistrement)
'Copie de l'enregistrement lu dans la feuille zone_a_lire
' zone_a_lire.[A1].Offset(i) = ligne_analysee
'initialisation à chaque nouvelle ligne analysée
nb_champs_cpt = 1
Longueur_cumulee = 0
'boucle pour lire la variable tableau alimentée par les cellules définissant la structure
'à partir de la ligne 2 du tableau pour pas prendre la ligne contenant les étiquettes Champ & Longueur
For rw = 2 To UBound(arr, 1)
For cl = 1 To UBound(arr, 2)
' Debug.Print arr(rw, cl)
If cl = 1 Then Champ = arr(rw, cl): zone_decryptee.Cells(3, nb_champs_cpt).Value = Champ
If cl > 1 Then
Longueur = arr(rw, cl)
If Longueur_cumulee = 0 Then Longueur_cumulee = 1
zone_decryptee.Cells(3 + i, nb_champs_cpt).Value = Mid(ligne_analysee, Longueur_cumulee, Longueur)
Longueur_cumulee = Longueur_cumulee + Longueur
End If
Next
nb_champs_cpt = nb_champs_cpt + 1
Next
i = i + 1
Next c
zone_decryptee.Activate: [A1].Select
End Sub
Function File2String(strFile) As Variant
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForReading = 1
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(strFile) Then
Set ts = fs.OpenTextFile(strFile, ForReading, True)
If ts.AtEndOfStream Then
File2String = ""
Else
File2String = ts.ReadAll
End If
ts.Close
Else
File2String = ""
End If
End Function