OK je tente.
Uniquement celle-là ou les autres aussi??
Avec Excel2003 tu as aussi les lignes suivantes??
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
Voilà la macro que j'ai:
Option Explicit
'nom de la feuille où sont importées les données
Private Const nomFeuilleImport As String = "Feuille Import"
Public Sub AnalyseFichierUnv()
Dim mem1 As Boolean, mem2 As Boolean, mem3 As Long, numDerCol As Long, numDerLig As Long
'désactiver les options d'Excel
mem1 = Application.ScreenUpdating: Application.ScreenUpdating = False
mem2 = Application.EnableEvents: Application.EnableEvents = False
mem3 = Application.Calculation: Application.Calculation = xlCalculationManual
'modifier les Noms (sources de données des graphiques)
ThisWorkbook.Names("Graph_Etiquettes").RefersTo = "=1"
ThisWorkbook.Names("Graph_Magnitude").RefersTo = "=1"
ThisWorkbook.Names("Graph_Phase").RefersTo = "=1"
Application.Calculate
'effacer les données de la "feuille import"
ThisWorkbook.Sheets(nomFeuilleImport).Cells.Clear
'importer les données à partir du fichier .unv
ImportUnv
'analyser les données (bilan des sommes, magnitude, phase)
FaireBilan
'modifier les Noms (sources de données des graphiques)
With ThisWorkbook.Sheets(nomFeuilleImport)
numDerCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
numDerLig = .Cells(.Rows.Count, numDerCol).End(xlUp).Row
ThisWorkbook.Names("Graph_Etiquettes").RefersTo = "='" & .Name & "'!" & .Range("$A$3:$A$" & numDerLig).Address
ThisWorkbook.Names("Graph_Magnitude").RefersTo = "='" & .Name & "'!" & .Range(.Cells(3, numDerCol - 1), .Cells(numDerLig, numDerCol - 1)).Address
ThisWorkbook.Names("Graph_Phase").RefersTo = "='" & .Name & "'!" & .Range(.Cells(3, numDerCol), .Cells(numDerLig, numDerCol)).Address
Application.Calculate
End With
'remettre en état les options d'Excel
Application.ScreenUpdating = mem1
Application.EnableEvents = mem2
Application.Calculation = mem3
End Sub
Private Sub ImportUnv()
Dim fichierUnv As Object, ligneCourante As String, capteurCourant As String, fichiersUnv As Variant, iFichier As Integer, iCapteur As Integer
Dim frequence As Double, incrementation As Double, compteurLigneEcriture As Long, compteurLigneLecture As Long, compteurIncrementation As Long, tabStr() As String
iCapteur = 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
With ThisWorkbook.Sheets(nomFeuilleImport)
'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
compteurLigneEcriture = 2
'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
If fichierUnv.AtEndOfStream Then Exit Sub
'récupérer les diférentes valeurs de la ligne dans un tableau
tabStr = Split(NettoyerEspaces(fichierUnv.ReadLine), " ")
'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
'afficher les entêtes de colonnes
.Range("A2").Value = "Fréquence"
.Range("A2").Offset(0, iCapteur * 2 + 1).Value = "Partie Réelle"
.Range("A2").Offset(0, iCapteur * 2 + 2).Value = "Partie Imaginaire"
'boucler sur les lignes contenant les valeurs (jusqu'à la ligne contenant le "-1")
compteurIncrementation = 0
While (Not fichierUnv.AtEndOfStream) And ligneCourante <> "-1"
ligneCourante = NettoyerEspaces(fichierUnv.ReadLine)
'récupérer les diférentes valeurs de la ligne dans un tableau
tabStr = Split(ligneCourante, " ")
'écrire les diférentes valeurs
If ligneCourante <> "-1" Then
'premier terme de la ligne
compteurLigneEcriture = compteurLigneEcriture + 1
.Range("A1").Offset(0, iCapteur * 2 + 1).Value = "Capteur " & capteurCourant
.Range("A1").Resize(1, 2).Offset(0, iCapteur * 2 + 1).MergeCells = True
.Range("A1").Resize(1, 2).Offset(0, iCapteur * 2 + 1).HorizontalAlignment = xlCenter
.Range("A" & compteurLigneEcriture).Value = frequence + (compteurIncrementation * incrementation)
.Range("A" & compteurLigneEcriture).Offset(0, iCapteur * 2 + 1).Value = tabStr(0)
.Range("A" & compteurLigneEcriture).Offset(0, iCapteur * 2 + 2).Value = tabStr(1)
compteurIncrementation = compteurIncrementation + 1
'deuxième terme de la ligne
compteurLigneEcriture = compteurLigneEcriture + 1
.Range("A" & compteurLigneEcriture).Value = frequence + (compteurIncrementation * incrementation)
.Range("A" & compteurLigneEcriture).Offset(0, iCapteur * 2 + 1).Value = tabStr(2)
.Range("A" & compteurLigneEcriture).Offset(0, iCapteur * 2 + 2).Value = tabStr(3)
compteurIncrementation = compteurIncrementation + 1
'troisième terme de la ligne
compteurLigneEcriture = compteurLigneEcriture + 1
.Range("A" & compteurLigneEcriture).Value = frequence + (compteurIncrementation * incrementation)
.Range("A" & compteurLigneEcriture).Offset(0, iCapteur * 2 + 1).Value = tabStr(4)
.Range("A" & compteurLigneEcriture).Offset(0, iCapteur * 2 + 2).Value = tabStr(5)
compteurIncrementation = compteurIncrementation + 1
End If
Wend
iCapteur = iCapteur + 1
Wend
'fermer le fichier .unv
fichierUnv.Close
Next iFichier
End With
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
'analyser les données (bilan des sommes, magnitude, phase)
Private Sub FaireBilan()
Dim nbLignes As Long, nbColonnes As Long, i As Long, j As Long, somReel As Double, somImag As Double
With ThisWorkbook.Sheets(nomFeuilleImport)
nbLignes = .Range("A" & .Rows.Count).End(xlUp).Row
nbColonnes = .Cells(2, .Columns.Count).End(xlToLeft).Column
.Cells(2, nbColonnes + 2).Value = "Somme Parties Réelles"
.Cells(2, nbColonnes + 3).Value = "Somme Parties Imaginaires"
.Cells(2, nbColonnes + 5).Value = "Magnitude"
.Cells(2, nbColonnes + 6).Value = "Phase"
For i = 3 To nbLignes
somReel = 0: somImag = 0
For j = 2 To nbColonnes Step 2
somReel = somReel + .Cells(i, j).Value
somImag = somImag + .Cells(i, j).Offset(0, 1).Value
Next j
If somReel + somImag <> 0 Then
.Cells(i, nbColonnes + 2).Value = somReel
.Cells(i, nbColonnes + 3).Value = somImag
.Cells(i, nbColonnes + 5).Value = (somReel ^ 2 + somImag ^ 2) ^ (0.5)
.Cells(i, nbColonnes + 6).Value = Atn(somImag / somReel) * 180 / WorksheetFunction.Pi
End If
Next i
'mise en forme des données
MettreEnFormeZone .Range("A2")
MettreEnFormeZone .Range("A3:A" & nbLignes)
For i = 2 To nbColonnes Step 2
MettreEnFormeZone .Range(.Cells(1, i), .Cells(1, i + 1))
MettreEnFormeZone .Range(.Cells(2, i), .Cells(2, i + 1))
MettreEnFormeZone .Range(.Cells(3, i), .Cells(nbLignes, i + 1))
.Range(.Cells(3, i), .Cells(nbLignes, i + 1)).NumberFormat = "0.00"
Next i
MettreEnFormeZone .Range(.Cells(2, nbColonnes + 2), .Cells(nbLignes, nbColonnes + 3))
.Range(.Cells(3, nbColonnes + 2), .Cells(nbLignes, nbColonnes + 3)).NumberFormat = "0.00"
MettreEnFormeZone .Range(.Cells(2, nbColonnes + 5), .Cells(nbLignes, nbColonnes + 6))
.Range(.Cells(3, nbColonnes + 5), .Cells(nbLignes, nbColonnes + 6)).NumberFormat = "0.00"
.Range("A1", .Cells(nbLignes, nbColonnes + 6)).Font.Bold = True
.Cells.EntireColumn.AutoFit
End With
End Sub
Private Sub MettreEnFormeZone(zone As Range)
zone.Borders(xlDiagonalDown).LineStyle = xlNone
zone.Borders(xlDiagonalUp).LineStyle = xlNone
With zone.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
With zone.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
With zone.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
With zone.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlMedium
End With
With zone.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
With zone.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
End Sub
