[VBA] Exécuter une action "POUR CHAQUE" .csv ouvert

Bonjour,

J'ai plusieurs fichiers CSV générés (c'est en réalité une sortie de PING Windows).

• J'ai une première macro qui éclate les données, me créant, qu'une colonne avec en première ligne, le nom du .csv, et ensuite, toutes les valeurs en ms.
• Je fais une copie de chaque colonne A dans un nouveau .xls(C'est là que je cherche une solution)
• Une deuxième macro fait, avec les X colonnes (des X fichiers CSV), un graphique, en mettant les bonnes sources de données et les bonnes échelles X Y.

J'ai plusieurs CSV d'ouverts.

Ma macro s'appelle "Forme_CSV" (Pour L'éclatement des données)

La deuxième s'appelle "Graph_Ping" (Pour créer le graphique)

J'ai besoin d'aide pour faire une macro appelée "Copie_vers_XLS"

Dans l'idée, je voudrais créer une super macro "Stat_Ping" qui face un genre de :

Pour chaque *.csv Faire

Call Forme_CSV()

Call Copie_vers_XLS()

Call Graph_Ping()

La partie en gras me pose problème.

Je ne sais quelle fonction utiliser ni comment lister les fichiers ouverts.

Merci

Bonjour,

Peux-tu envoyer le fichier comportant ton code et un exemple de fichier csv?

Cordialement.

Bonjour,

je joins ça, les CSV, le Excel à l'étape 1 (quand le fichier est mis en forme avant de lancer Graph_Ping) et le résultat final.

Comme c'est un PING sur 4-5 heures, c'est normal que le graphe soit si long.

Merci

Re,

Pour le fichier Excel, okay!

Mais pour les csv, ou trouve-t-on les heures?

A+

Salut,

Pour tester, mets une heure bidon de la forme hh:mm:ss.

L'heure est dans les métadonnées du fichier, "Date de création".

Puis, la macro incrémente d'une seconde les horaires à chaque ligne. (Je ne sais pas récupérer dans Excel la date de création du fichier et je ne pense pas que ce soit possible.).

Merci

Re,

ça te convient ce que je t'ai donné ?

Je cherche toujours de mon côté, j'ai trouvé une macro qui liste les fichiers Excel ouverts. J'ai tenté d'adapter un peu avec un SI dedans. Cela semble fonctionner.

Dim Wb As Workbook
For Each Wb In Workbooks
If Right(Wb.Name, 4) = ".csv" Then
    MsgBox Wb.Name
End If
Next Wb

Edit:

Je continue le traitement, c'est peut être la solution: En gros, dans le If, je mets tout ce que je veux faire, cela fonctionne.

Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\stat.xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

Dim Wb As Workbook
For Each Wb In Workbooks
If Right(Wb.Name, 4) = ".csv" Then
    'MsgBox Wb.Name
    Windows(Wb.Name).Activate
    Columns("A:A").Select
    Selection.Copy
    Windows("stat.xls").Activate
    Columns("A:A").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next Wb

Bonjour,

Voici finalement la macro finale, si ça peut aider:

Sub Main_Ping()
''' PROGRAMME PRINCIPAL APPELANT LES AUTRES MACROS '''

Dim nom_i As String
Dim heure_i As String
nom_i = InputBox("Nom du fichier à enregistrer sous C:\ ?") & "_.xls"
heure_i = InputBox("Heure de début?")

Call Liste_CSV(nom_i)
Call Graph_Ping(heure_i)

End Sub

Sub Liste_CSV(nom_m As String)

Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\" & nom_m, _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

Dim Wb As Workbook
For Each Wb In Workbooks
If Right(Wb.Name, 4) = ".csv" Then
    Windows(Wb.Name).Activate
    Call Forme_CSV
    Windows(nom_m).Activate
    Columns("A:A").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next Wb

End Sub

Sub Forme_CSV()
Application.DisplayAlerts = False

    Range("A1").Select

''' ON CASSE LES DONNEES POUR NE GARDER QUE LES ms '''

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1)), TrailingMinusNumbers:=True
    Columns("A:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="=", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Selection.Delete Shift:=xlToLeft

    Range("A1").Select

''' ON REMPLACE LES PAQUETS PERDUS PAR 5000 '''

    Columns("A:A").Select
    Selection.Replace What:="", Replacement:="5000", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Rows("1:1").Select
    Selection.ClearContents

    Range("A1").Select

''' ON CLEAN LES INFOS EN BAS (stats) '''

    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select

    Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row - 5).Select

    Selection.ClearContents

    Range("A1").Select
    ActiveCell.FormulaR1C1 = ActiveSheet.Name

    Columns("A:A").Select
    Selection.Copy

Application.DisplayAlerts = True
End Sub

''''''' METTRE COMMENTAIRES APRES

Sub Graph_Ping(heure_m As String)

Range("A1").Select
ActiveCell.FormulaR1C1 = "Heure"

lignemax = 0
While ActiveCell.Offset(lignemax, 1).Value <> ""
    lignemax = lignemax + 1
Wend

Range("A2").Select

ActiveCell.FormulaR1C1 = heure_m
seconde_m = Val(Right(heure_m, 2)) + 1
heure_m = Left(heure_m, 6) & seconde_m
Range("A3").Select
ActiveCell.FormulaR1C1 = heure_m
Range("A2:A3").Select
Selection.AutoFill Destination:=Range("A2:A" & lignemax), Type:=xlFillDefault
Range("A2:A" & lignemax).Select

Range("A1").Select

ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.SetSourceData Source:=Range("'" & ActiveSheet.Name & "'!$A$1:$D$" & lignemax)

ActiveSheet.Shapes("Graphique 1").ScaleHeight 1.2895530767, msoFalse, _
    msoScaleFromBottomRight
ActiveSheet.Shapes("Graphique 1").ScaleWidth 26.6766303587, msoFalse, _
    msoScaleFromTopLeft

Range("A2").Select
Selection.Copy
Range("Z1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.NumberFormat = "General"
echelleY1 = Range("Z1").Value

Range("A" & lignemax).Select
Selection.Copy
Range("Z2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.NumberFormat = "General"
echelleY2 = Range("Z2").Value

ActiveSheet.ChartObjects("Graphique 1").Activate

ActiveChart.Axes(xlCategory).MinimumScale = echelleY1
ActiveChart.Axes(xlCategory).MaximumScale = echelleY2

ActiveChart.Axes(xlValue).MaximumScale = 6000
ActiveChart.Axes(xlValue).MaximumScale = 5000
ActiveChart.Axes(xlValue).MinimumScale = -1000
ActiveChart.Axes(xlValue).MinimumScale = 0
ActiveChart.Axes(xlCategory).MajorUnit = 6.94444444444444E-03

End Sub

Bonjour,

Je te joints un fichier avec macro qui ouvrent les fichiers csv et les consolident pour traitement..

A adapter et tester dans ton projet.

L'idée est de faire un seul traitement des fichiers csv.

Cordialement

Option Explicit
Public Sub Import()

Dim MyFile, MyPath, MyName
Dim a As Boolean
Dim FichierActuel

    Application.ScreenUpdating = False

    ChDir ThisWorkbook.Path
    FichierActuel = ThisWorkbook.Name
    Cells.ClearContents
    MyFile = Dir("Fichier*.csv") ' premier fichier
    Do While MyFile <> ""

        Workbooks.OpenText Filename:=MyFile, DataType:=xlDelimited, Tab:=True
            If a Then
                [A1].CurrentRegion.Select
                    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Copy _
                    Workbooks(FichierActuel).Sheets(1).[A65000].End(xlUp).Offset(1, 0)
            Else
            [A1].CurrentRegion.Copy Workbooks(FichierActuel).Sheets("Données").[A1]
            End If
        ActiveWorkbook.Close
    MyFile = Dir ' fichier suivant
    a = True
    Loop
End Sub