Probléme programmation VBA

jeanbat29

XLDnaute Nouveau
Bonjour,
Un petit soucis: j'ai des fichiers .univ qui sont des résultats d'essais, écrits comme un fichier .txt, avec des tas de chiffres séparés par des espaces.
J'aimerais créer un fichier excel qui me "range" ces données, une valaur dans chaque cellule.
J'essaie de trouver des explications sur VBA, mais j'y comprends que couic. A la base je suis ingé en mécanique, très mateux mais j'ai jamais été fichu de taper ou de comprendre un prodramme il faut dire...
Quelqu'un connait il une vraie initiation à VBA (Tout ce que je trouve, au bout de 4 lignes je suis paumé...).
merci
 

mromain

XLDnaute Barbatruc
Re : Probléme programmation VBA

Bonjour,
Un petit soucis: j'ai des fichiers .univ qui sont des résultats d'essais, écrits comme un fichier .txt, avec des tas de chiffres séparés par des espaces.
J'aimerais créer un fichier excel qui me "range" ces données, une valaur dans chaque cellule.
J'essaie de trouver des explications sur VBA, mais j'y comprends que couic. A la base je suis ingé en mécanique, très mateux mais j'ai jamais été fichu de taper ou de comprendre un prodramme il faut dire...
Quelqu'un connait il une vraie initiation à VBA (Tout ce que je trouve, au bout de 4 lignes je suis paumé...).
merci

bonjour jeanbat29,

peux-tu joindre un exemple de fichier .univ (que tu veux importer) ainsi que le fichier excel que tu souhaites comme résultat stp ?

a+
 

jeanbat29

XLDnaute Nouveau
Re : Problème programmation VBA

OK, j'explique plus en détail.
Ci-joint le fichier .univ

Les 17 premières lignes, j'en ai pas besoin.
A la 18 ème ligne, le 58 indique le format du fichier universal. Je m'explique:

Ligne 24, P1 représente le nom du capteur corrsepondant à la série de mesures. Il y en a 17 en tout: P1, P2, 1x, 1y, 1z, 2x, 2y ainsi de suite jusqu'à 5x, 5y, 5z.

Ligne 25, 4ème valeur, le 5 représente 5 Hertz.
5ème valeur, le 1 représente l'incrémentation
Soit première valeur 5Hz, seconde 6Hz, troisième 7Hz et ainsi de suite.

Ligne 30, les mesures commencent. 6 valeurs par ligne. 2 valeurs par fréquence.
Soit pour la ligne 30:
Première valeur: Partie réelle à 5Hz
Seconde valeur: partie imaginaire à 5Hz
Troisième valeur: Partie réelle à 6Hz
Quatrième valeur: Partie imaginaire à 6Hz
Cinquième valeur: Partie réelle à 7Hz
Sixième valeur: Partie imaginaire à 7Hz

Et donc pour la ligne 31:
Première valeur: Partie réelle à 8Hz
Seconde valeur: partie imaginaire à 8Hz
Troisième valeur: Partie réelle à 9Hz
Quatrième valeur: Partie imaginaire à 9Hz
Cinquième valeur: Partie réelle à 10Hz
Sixième valeur: Partie imaginaire à 10Hz

Et comme ça jusqu'à -1 -1 58 puis on passe au capteur P2

Ce que je voudrais faire, c'est un programme VBA, qui me construise un fichier excel (2003) comme le fichier joint Test.xls avec pour chaque capteur les fréquences, les parties réelles et imaginaires correspondantes.

Mais bon, sans aucunes connaissances en programmation, je râme sévère...
Comment faire??
Même quand je lis des tutoriaux pour débutant, au bout de 30secondes je suis paumé...
 

jeanbat29

XLDnaute Nouveau
Re : Probléme programmation VBA

Mes fichiers ont trop balèzes pour être joints... je post les premières lignes du fichier .univ

-1
151
hai-unv
NONE
LMS CADA-X Rev 3.3
NONE
NONE
LMS CADA-X TEST APPLICATION MANAGER
05-Mar-109 09:50:15
-1
-1
164
1 Metric SI
1.00000000000000000D+00 1.00000000000000000D+00 1.00000000000000000D+00
0.00000000000000000D+00
-1
-1
58
frequency_spectr (peak_amplitude) for P1 / P1
response / response 577.90e-03 g
23-Feb-09 14:32:12
Rec 121 of test "3y"
NONE
12 0 121 0 P1 0 0 P1 0 0
5 1996 1 5.00000e+00 1.00000e+00 0.00000e+00
18 0 0 0 NONE Hz
12 0 0 0 Channel 1(1) g
0 0 0 0 Channel 1(1) NONE
0 0 0 0 NONE NONE
5.03137e-01 0.00000e+00 5.07535e-01 0.00000e+00 5.08872e-01 0.00000e+00
4.99346e-01 0.00000e+00 5.01913e-01 0.00000e+00 5.01162e-01 0.00000e+00
 

jeanbat29

XLDnaute Nouveau
Re : Probléme programmation VBA

bon en fait, en réduisant mon fichier, j'arrive à le joindre.
Mais j'ai uniquement 8 lignes de mesures par capteur, au lieu de 666.

Le principe reste le même, à savoir que les capteurs sont séparés par -1 -1 58

Si quelqu'un arrive à suivre...il aura toute mon estime :)
 

Pièces jointes

  • Test.xls
    13.5 KB · Affichages: 91
  • Test.xls
    13.5 KB · Affichages: 93
  • Test.xls
    13.5 KB · Affichages: 93
  • 3y.zip
    1.2 KB · Affichages: 46

jeanbat29

XLDnaute Nouveau
Re : Probléme programmation VBA

Génial mromain, merci beaucoup!
Je vais essayer de comprendre le programme, ça m'aide énormément d'avoir un exemple détaillé.

Juste une question: Dans ton programme, je dois définir le chemin du fichier .unv à importer: pathfichierUnv = ThisWorkbook.Path & "\3y.unv"

Comme j'ai d'autres fichiers: 1y.unv, 2y.unv, 1x.unv et beaucoup d'autres, serait il possible de créer une messagebox quand on lance la macro, permettant de demander le chemin d'accès au fichier univ???
 

mromain

XLDnaute Barbatruc
Re : Probléme programmation VBA

re bonjour jeanbat29,

ci-joint la macro modifiée (je ne l'ai pas testée)
elle ouvre une boite de dialogue qui permet de sélectionner soit :
- un seul fichier .unv
- plusieurs fichiers .unv avec la touche <Ctrl>

Code:
Public Sub TestImportUnv()
Dim fichierUnv As Object, ligneCourante As String, capteurCourant As String[B][COLOR=Red], fichiersUnv As Variant, iFichier As Integer[/COLOR][/B]
Dim frequence As Double, incrementation As Double, compteurLigneEcriture As Integer, compteurLigneLecture As Integer, compteurIncrementation As Integer, tabStr() As String
    
compteurLigneEcriture = 1

[COLOR=Red][B]'récupérer les fichiers à importer (multi-sélection possible avec la touche Ctrl)
fichiersUnv = Application.GetOpenFilename("Fichiers .unv,*.unv", , "Fichiers à importer :", , True)

'si la fenêtre de sélection a été fermée sans de fichiers sélectionnées, quitter la macro
If VarType(fichiersUnv) = vbBoolean Then Exit Sub
 
'boucler sur les fichiers sélectionnés
For iFichier = LBound(fichiersUnv) To UBound(fichiersUnv)[/B][/COLOR]
    
    'ouvrir le fichier courant
    Set fichierUnv = CreateObject("Scripting.FileSystemObject").OpenTextFile([COLOR=Red][B]fichiersUnv(iFichier)[/B][/COLOR], 1)
    
    'Tant qu'on est pas à la fin du fichier
    While Not fichierUnv.AtEndOfStream
        
        'aller jusqu'à la prochaine ligne commançant par "frequency_spectr (peak_amplitude) for "
        While (ligneCourante Like "frequency_spectr (peak_amplitude) for *" = False) And (Not fichierUnv.AtEndOfStream)
            ligneCourante = fichierUnv.ReadLine
        Wend
        
        'on va récupérer le capteur analysé (les 2 caractères après "frequency_spectr (peak_amplitude) for ")
        capteurCourant = Left(Replace(ligneCourante, "frequency_spectr (peak_amplitude) for ", ""), 2)
        
        'sauter 5 ligne (pour récupérer la fréquence et l'incrémentation
        compteurLigneLecture = 0
        While (Not fichierUnv.AtEndOfStream) And (compteurLigneLecture <= 5)
            ligneCourante = fichierUnv.ReadLine
            compteurLigneLecture = compteurLigneLecture + 1
        Wend
        
        'récupérer les diférentes valeurs de la ligne dans un tableau
        tabStr = Split(NettoyerEspaces(ligneCourante), " ")
        'récupérer la fréquence et l'incrémentation
        frequence = CDbl(Evaluate(tabStr(3)))
        incrementation = CDbl(Evaluate(tabStr(4)))
        
        'sauter les 4 lignes suivantes
        compteurLigneLecture = 0
        While (Not fichierUnv.AtEndOfStream) And (compteurLigneLecture < 4)
            ligneCourante = fichierUnv.ReadLine
            compteurLigneLecture = compteurLigneLecture + 1
        Wend
        
        'boucler sur les 8 lignes contenant les valeurs
        compteurLigneLecture = 0: compteurIncrementation = 0
        While (Not fichierUnv.AtEndOfStream) And (compteurLigneLecture < 8)
            compteurLigneLecture = compteurLigneLecture + 1
            ligneCourante = fichierUnv.ReadLine
            
            'récupérer les diférentes valeurs de la ligne dans un tableau
            tabStr = Split(NettoyerEspaces(ligneCourante), " ")
            
            'écrire les diférentes valeurs
            'premier terme de la ligne
            compteurLigneEcriture = compteurLigneEcriture + 1
            Range("A" & compteurLigneEcriture).Value = capteurCourant
            Range("B" & compteurLigneEcriture).Value = frequence + (compteurIncrementation * incrementation)
            Range("C" & compteurLigneEcriture).Value = tabStr(0)
            Range("D" & compteurLigneEcriture).Value = tabStr(1)
            compteurIncrementation = compteurIncrementation + 1
        
            'deuxième terme de la ligne
            compteurLigneEcriture = compteurLigneEcriture + 1
            Range("A" & compteurLigneEcriture).Value = capteurCourant
            Range("B" & compteurLigneEcriture).Value = frequence + (compteurIncrementation * incrementation)
            Range("C" & compteurLigneEcriture).Value = tabStr(2)
            Range("D" & compteurLigneEcriture).Value = tabStr(3)
            compteurIncrementation = compteurIncrementation + 1
        
            'troisième terme de la ligne
            compteurLigneEcriture = compteurLigneEcriture + 1
            Range("A" & compteurLigneEcriture).Value = capteurCourant
            Range("B" & compteurLigneEcriture).Value = frequence + (compteurIncrementation * incrementation)
            Range("C" & compteurLigneEcriture).Value = tabStr(4)
            Range("D" & compteurLigneEcriture).Value = tabStr(5)
            compteurIncrementation = compteurIncrementation + 1
        Wend
        
    Wend
    
    'fermer le fichier .unv
    fichierUnv.Close
[COLOR=Red][B]Next iFichier[/B][/COLOR]
Set fichierUnv = Nothing
End Sub


'efface les multiples espaces dans une chaine de caractère
Private Function NettoyerEspaces(texte As String) As String
While InStr(texte, "  ")
    texte = Replace(texte, "  ", " ")
Wend
If Right(texte, 1) = " " Then texte = Left(texte, Len(texte) - 1)
If Left(texte, 1) = " " Then texte = Right(texte, Len(texte) - 1)
NettoyerEspaces = texte
End Function
a+
 
Dernière édition:

jeanbat29

XLDnaute Nouveau
Re : Probléme programmation VBA

Terrible, ça marche d'enfer.
Par contre, quand j'utilise mes fichiers .univ non modifiés. C'est à dire avec 666 lignes de mesures pour chaque capteur et non plus 8, ça marche plus, message d'erreur: Run time error '9': Subscript out of range
 

jeanbat29

XLDnaute Nouveau
Re : Probléme programmation VBA

Du coup dans ton programme: 'boucler sur les 8 lignes contenant les valeurs'
Je remplace 8 par 666 mais en lançant la macro, j'ai Run time error '6': Overflow

Trop de lignes en gros, faudrait ranger chaque capteur dans une colonne différente.
J'essaie mais purée j'ai du boulot en VBA...
 

mromain

XLDnaute Barbatruc
Re : Probléme programmation VBA

re,

voici un essai, mais vu qu'on ne travaille pas avec les mêmes fichiers, c'est de moins facile de te suivre...

Code:
Public Sub TestImportUnv()
Dim fichierUnv As Object, ligneCourante As String, capteurCourant As String, fichiersUnv As Variant, iFichier As Integer, compteurColonne As Integer
Dim frequence As Double, incrementation As Double, compteurLigneEcriture As Integer, compteurLigneLecture As Integer, compteurIncrementation As Integer, tabStr() As String
    
compteurLigneEcriture = 1
compteurColonne = 0

'récupérer les fichiers à importer (multi-sélection possible avec la touche Ctrl)
fichiersUnv = Application.GetOpenFilename("Fichiers .unv,*.unv", , "Fichiers à importer :", , True)

'si la fenêtre de sélection a été fermée sans de fichiers sélectionnées, quitter la macro
If VarType(fichiersUnv) = vbBoolean Then Exit Sub
 
'boucler sur les fichiers sélectionnés
For iFichier = LBound(fichiersUnv) To UBound(fichiersUnv)
    
    'ouvrir le fichier courant
    Set fichierUnv = CreateObject("Scripting.FileSystemObject").OpenTextFile(fichiersUnv(iFichier), 1)
    
    'Tant qu'on est pas à la fin du fichier
    While Not fichierUnv.AtEndOfStream
        
        'aller jusqu'à la prochaine ligne commançant par "frequency_spectr (peak_amplitude) for "
        While (ligneCourante Like "frequency_spectr (peak_amplitude) for *" = False) And (Not fichierUnv.AtEndOfStream)
            ligneCourante = fichierUnv.ReadLine
        Wend
        
        'on va récupérer le capteur analysé (les 2 caractères après "frequency_spectr (peak_amplitude) for ")
        capteurCourant = Left(Replace(ligneCourante, "frequency_spectr (peak_amplitude) for ", ""), 2)
        
        'sauter 5 ligne (pour récupérer la fréquence et l'incrémentation
        compteurLigneLecture = 0
        While (Not fichierUnv.AtEndOfStream) And (compteurLigneLecture <= 5)
            ligneCourante = fichierUnv.ReadLine
            compteurLigneLecture = compteurLigneLecture + 1
        Wend
        
        'récupérer les diférentes valeurs de la ligne dans un tableau
        tabStr = Split(NettoyerEspaces(ligneCourante), " ")
        'récupérer la fréquence et l'incrémentation
        frequence = CDbl(Evaluate(tabStr(3)))
        incrementation = CDbl(Evaluate(tabStr(4)))
        
        'sauter les 4 lignes suivantes
        compteurLigneLecture = 0
        While (Not fichierUnv.AtEndOfStream) And (compteurLigneLecture < 4)
            ligneCourante = fichierUnv.ReadLine
            compteurLigneLecture = compteurLigneLecture + 1
        Wend
        
        'boucler sur les 8 lignes contenant les valeurs
        compteurLigneLecture = 0: compteurIncrementation = 0
        While (Not fichierUnv.AtEndOfStream) And (compteurLigneLecture < 8)
            compteurLigneLecture = compteurLigneLecture + 1
            ligneCourante = fichierUnv.ReadLine
            
            'récupérer les diférentes valeurs de la ligne dans un tableau
            tabStr = Split(NettoyerEspaces(ligneCourante), " ")
            
            'écrire les diférentes valeurs
            'premier terme de la ligne
            compteurLigneEcriture = compteurLigneEcriture + 1
            If compteurLigneEcriture > Rows.Count Then
                compteurLigneEcriture = 1
                compteurColonne = compteurColonne + 1
            End If
            Cells(compteurLigneEcriture, compteurColonne * 5 + 1).Value = capteurCourant
            Cells(compteurLigneEcriture, compteurColonne * 5 + 2).Value = frequence + (compteurIncrementation * incrementation)
            Cells(compteurLigneEcriture, compteurColonne * 5 + 3).Value = tabStr(0)
            Cells(compteurLigneEcriture, compteurColonne * 5 + 4).Value = tabStr(1)
            compteurIncrementation = compteurIncrementation + 1
        
            'deuxième terme de la ligne
            compteurLigneEcriture = compteurLigneEcriture + 1
            If compteurLigneEcriture > Rows.Count Then
                compteurLigneEcriture = 1
                compteurColonne = compteurColonne + 1
            End If
            Cells(compteurLigneEcriture, compteurColonne * 5 + 1).Value = capteurCourant
            Cells(compteurLigneEcriture, compteurColonne * 5 + 2).Value = frequence + (compteurIncrementation * incrementation)
            Cells(compteurLigneEcriture, compteurColonne * 5 + 3).Value = tabStr(2)
            Cells(compteurLigneEcriture, compteurColonne * 5 + 4).Value = tabStr(3)
            compteurIncrementation = compteurIncrementation + 1
        
            'troisième terme de la ligne
            compteurLigneEcriture = compteurLigneEcriture + 1
            If compteurLigneEcriture > Rows.Count Then
                compteurLigneEcriture = 1
                compteurColonne = compteurColonne + 1
            End If
            Cells(compteurLigneEcriture, compteurColonne * 5 + 1).Value = capteurCourant
            Cells(compteurLigneEcriture, compteurColonne * 5 + 2).Value = frequence + (compteurIncrementation * incrementation)
            Cells(compteurLigneEcriture, compteurColonne * 5 + 3).Value = tabStr(4)
            Cells(compteurLigneEcriture, compteurColonne * 5 + 4).Value = tabStr(5)
            compteurIncrementation = compteurIncrementation + 1
        Wend
        
    Wend
    
    'fermer le fichier .unv
    fichierUnv.Close
Next iFichier
Set fichierUnv = Nothing
End Sub


'efface les multiples espaces dans une chaine de caractère
Private Function NettoyerEspaces(texte As String) As String
While InStr(texte, "  ")
    texte = Replace(texte, "  ", " ")
Wend
If Right(texte, 1) = " " Then texte = Left(texte, Len(texte) - 1)
If Left(texte, 1) = " " Then texte = Right(texte, Len(texte) - 1)
NettoyerEspaces = texte
End Function


a+
 

Discussions similaires

Réponses
10
Affichages
350
Réponses
3
Affichages
594

Membres actuellement en ligne

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa