Extractions des commentaires dans un autre fichier

Bonjour,

Je voudrais un code VBA afin de permettre l'extraction des commentaires. J'y ai passé la journée et je ne comprends pas pourquoi cela ne fonctionne pas...Du coup, j'essaie de poster mon code ici en espérant trouver une âme charitable pouvant me dépatouiller.

Je voudrais que ma macro détecte le "C" ligne 2 et me fasse une extraction des commentaires associés dans un autre fichier dont le chemin est défini. Le reste de la macro consiste à passer en rouge les commentaires extraits car je peu définir les dates d'extractions.

Pour le moment, j'ai essayé de rajouter une période égale à "C" et de définir une fonction if en "C" comme pour les "M" et les "J" mais impossible, l'extraction ne fonctionne pas ...Pouvez-vous m'aider ?

Merci d'avance à celui qui ce dévouera

Sub Test()

    flag_zero = Workbooks("Test.xlsm").Worksheets("Programme").Range("C3")
    flag_extention = Workbooks("Test.xlsm ).Worksheets("Programme").Range("C5")
    If (flag_extention = "txt") Then
        separateur = Chr(9)
    Else
        separateur = ";"
    End If

    date_validation = InputBox("Date maxi : ", , Format(Now(), "dd/mm/yyyy"))

    Ficdestin_J = "c:\documents\" & ActiveCell.Worksheet.Name & "-" & Format(Date, "dd-mm-yy") & "-T." & flag_extention
    Open Ficdestin_J For Output As 1
    Print #1, " Code IP;Période;Index;Commentaire "

    flag_ana = 0

      If (Cells(6, 2) = "Dates") Then
        I = 3
        While (Cells(1, I) <> "FIN")
            Période = Cells(2, I)
            If (Période = "J" Or Période = "M") Then
                ic = 7
                While (Cells(ic, I) <> "FIN")
                    Valeurs = Cells(ic, I)
                    dateV = Cells(ic, 2)
                    o = DateDiff("d", dateV, date_validation)
                    If (DateDiff("d", dateV, date_validation) >= 0) Then

                        COMMENTAIRE = Cells(6, I)
                        If (((flag_zero = "Non" And Valeurs > 0) Or flag_zero = "Oui") And (Cells(ic, I).Font.ColorIndex = 1 Or Cells(ic, I).Font.ColorIndex = xlAutomatic) And Valeurs <> "") Then
                            If (Cells(ic, I) - Round(Cells(ic, I), 0) = 0) Then
                                Valeurs = Cells(ic, I)
                            Else
                                 Valeurs = Round(Cells(ic, I), 2)
                            End If
                            flag_ana = 1

                            If (Période = "M") Then
                                If (Cells(ic, 1) = "M") Then
                                    Print #1, ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;" & dateV & " 00:00:00;0;;;" & COMMENTAIRE & ";;;;;1;" & Valeurs & ";;MAN;0;0;;;;;"
                                    Cells(ic, I).Font.ColorIndex = 3
                                End If
                            ElseIf (Période = "J") Then
                                If (Cells(ic, 1) = "J") Then
                                    Print #1, ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;" & dateV & " 00:00:00;0;;;" & COMMENTAIRE & ";;;;;1;" & Valeurs & ";;MAN;0;0;;;;;"
                                    Cells(ic, I).Font.ColorIndex = 3
                                End If
                            End If
                        End If
                    Else
                        pp = 1
                    End If
                ic = ic + 1
                Wend
            End If
            I = I + 1
        Wend
      End If

    Close #1
    Close #2

        If flag_ana = 0 Then
            MsgBox "Pas de données à importer"
        Else
            MsgBox "Fichier " & Ficdestin_J & " et " & Ficdestin_M & " créé pour l'Import commentaire"
        End If

End Sub

Bonjour,

sans avoir testé déjà il manque un guillemet sur la 4e ligne

  flag_extention = Workbooks("Test.xlsm").Worksheets("Programme").Range("C5")

Oui déjà merci ^^ mais ça ne fonctionne pas