Macro VBA inversion des dates (jour et mois)

Bonjour,

Je me permets de solliciter votre aide sur une macro VBA que j'ai créé à l'aide de ChatGPT mais les limites de l'outil se font ressentir car il n'arrive pas à trouver de solution à mon problème. Ma macro permet d'extraire un PDF à partir d'une ligne de mon tableau financier avec toutes les informations utiles sur la ligne. Elle fonctionnait très bien jusqu'à ce que j'ai des opérations du 2 juin, en effet ma fiche opération PDF inverse le jour et le mois jusqu'au 12 du mois de juin (idem pour juillet, août...). J'ai cru comprendre qu'il s'agissait d'un problème de date américaine mais aucune des solutions que m'a donné ChatGPT n'a fonctionné. Je vous joins mon code complet ci-dessous :

Sub GenererFicheOperationAvecModeles()
    Dim wsSource As Worksheet
    Dim wsFiche As Worksheet
    Dim selectedRow As Long
    Dim header As String
    Dim celluleTrouvee As Range
    Dim i As Long
    Dim modeleFiche As String
    Dim nomFichierPDF As String
    Dim cheminTemp As String
    Dim cellValeur As Variant

    ' Déterminer la feuille active (source)
    Set wsSource = ActiveSheet

    ' Déterminer la ligne sélectionnée
    If TypeName(Selection) <> "Range" Then
        MsgBox "Veuillez sélectionner une cellule dans la ligne à traiter.", vbExclamation
        Exit Sub
    End If

    selectedRow = Selection.Row
    If selectedRow = 1 Then
        MsgBox "Veuillez sélectionner une ligne de données, pas l'en-tête.", vbExclamation
        Exit Sub
    End If

    ' Choisir le modèle de fiche en fonction de la feuille source
    Select Case wsSource.Name
        Case "ARBITRAGES"
            modeleFiche = "FICHE OPE ARBITRAGES"
        Case "VERSEMENTS - RACHATS"
            modeleFiche = "FICHE OPE VERSEMENTS"
        Case "DECES"
            modeleFiche = "FICHE OPE DECES"
        Case Else
            MsgBox "Feuille non reconnue pour la génération de fiche.", vbExclamation
            Exit Sub
    End Select

    ' Activer et rendre visible la feuille fiche correspondante
    Set wsFiche = ThisWorkbook.Sheets(modeleFiche)
    wsFiche.Visible = xlSheetVisible
    wsFiche.Activate

    ' Parcourir toutes les colonnes de la ligne sélectionnée
    For i = 1 To wsSource.Cells(1, Columns.Count).End(xlToLeft).Column
        header = wsSource.Cells(1, i).Value

        If header <> "Commentaire réglementaire" And header <> "Commentaire" Then
            Set celluleTrouvee = wsFiche.Cells.Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole)
            If Not celluleTrouvee Is Nothing Then
    With wsSource.Cells(selectedRow, i)
        celluleTrouvee.Offset(0, 1).Value = .Text
    End With
End If
            End If
    Next i

    ' Générer un PDF pour prévisualisation
    cheminTemp = Environ("TEMP") & "\Fiche_Operation.pdf"
    wsFiche.ExportAsFixedFormat Type:=xlTypePDF, Filename:=cheminTemp, Quality:=xlQualityStandard, _
                                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

    MsgBox "Fiche générée avec succès !", vbInformation
End Sub

J'espère vraiment que vous pourrez m'aider, je suis dans la panade si je n'arrive pas à corriger ce problème. J'ai joins mon tableau financier en supprimant toutes les données personnelles.

Je reste à votre disposition si vous avez besoin de renseignements complémentaires.

Belle journée,

Otselen

Bonjour,

Le code peut-être simplifié mais bon.

remplacez Text par Value dans cette ligne de code.

With wsSource.Cells(selectedRow, i)
        celluleTrouvee.Offset(0, 1).Value = .Text
    End With

Si cela ne résous pas votre problème il faudra peut-être regarder du coté des paramètres Windows et Excel.

Hello,

remplacez la ligne celluleTrouvee.Offset(0, 1).Value = .Text par celluleTrouvee.Offset(0, 1).Value = .Value

Hello,

Une proposition de correction avec quelques optimisations

Sub GenererFicheOperation()
    Dim wsSource As Worksheet, wsFiche As Worksheet
    Dim selectedRow As Long, i As Long, modeleFiche As String, cheminTemp As String
    Set wsSource = ActiveSheet
    selectedRow = Selection.Row: If selectedRow = 1 Then Exit Sub

    modeleFiche = Choose(Application.Match(wsSource.Name, Array("ARBITRAGES", "VERSEMENTS - RACHATS", "DECES"), 0), _
                         "FICHE OPE ARBITRAGES", "FICHE OPE VERSEMENTS", "FICHE OPE DECES")
    If modeleFiche = "" Then Exit Sub

    Set wsFiche = Sheets(modeleFiche): wsFiche.Visible = xlSheetVisible: wsFiche.Activate
    For i = 1 To wsSource.Cells(1, Columns.Count).End(xlToLeft).Column
        With wsSource.Cells(selectedRow, i)
            If .Value <> "" And .Offset(-selectedRow + 1, 0).Value <> "Commentaire réglementaire" Then
                Set celluleTrouvee = wsFiche.Cells.Find(.Offset(-selectedRow + 1, 0).Value, LookAt:=xlWhole)
                If Not celluleTrouvee Is Nothing Then celluleTrouvee.Offset(0, 1).Value = IIf(IsDate(.Value), Format(CDate(.Value), "DD/MM/YYYY"), .Text)
            End If
        End With
    Next i

    cheminTemp = Environ("TEMP") & "\Fiche_Operation.pdf"
    wsFiche.ExportAsFixedFormat Type:=xlTypePDF, Filename:=cheminTemp, Quality:=xlQualityStandard, OpenAfterPublish:=True
End Sub

@+

Je vous remercie du fond du cœur, vous avez solutionnez mon problème avec le changement par "Value". Je ne sais même pas comment vous remercier pour votre rapidité ! Par contre, bizarrement mes feuilles masquées "fiches opérations" restent visibles après l'exécution de ma VBA (ce qui n'était pas le cas avant), je vais chercher d'où vient le problème.

Pour Baroute78, j'ai copié collé ta proposition de simplification mais j'ai eu un message d'erreur : Erreur d'exécution "13" : Incompatibilité de type.

Merci pour tout malgré tout :)

Rechercher des sujets similaires à "macro vba inversion dates jour mois"