Mise à jour d'un fichier .xlsm depuis un fichier .csv

Le 14/11/2024 à 12:27

Bonjour à tous !

Une macro me permet de faire une mise à jour d'un fichier .xlsm depuis un fichier source en .xlsx. Cette macro fonctionne parfaitement.

Cependant, le fichier source .xlsx est obtenu après avoir manuellement enregistré un fichier .csv (CSV UTF-8 délimité par des virgules) en fichier xlsx. Pour éviter que l'utilisateur enregistre ce fichier .csv en .xlsx je voudrais que la macro le fasse automatiquement.

J'ai essayé plusieurs méthodes, mais cela ne marche pas. En effet, l'enregistrement du . cvs en .xlsx change la mise en forme et ajoute les séparateurs ; et des lettres comme éfà à la place des é ou des è.

J'ai changé de méthode en faisant une macro qui n'enregistre pas mais qui copie/colle simplement toutes les cellules du fichier .csv vers une feuille temporaire du fichier .xlsm. Le problème est toujours présent.

C'est frustrant car l'enregistrement en manuel marche parfaitement !

Merci d'avance pour votre aide ! Je joins le code en entier, même si pour moi le problème se situe dans les premières lignes du code, lors de la copie du fichier .csv vers le .xlsm.

Sub UpdateMEEI()
    Dim wsTemp As Worksheet
    Dim wsMEEI As Worksheet
    Dim filePath As String
    Dim csvWorkbook As Workbook

    ' Ouvrir une boîte de dialogue pour sélectionner le fichier CSV
    filePath = Application.GetOpenFilename("Fichiers CSV (*.csv), *.csv", , "Sélectionnez le fichier extraction.csv")

    ' Vérifier si un fichier a été sélectionné
    If filePath = "Faux" Then
        MsgBox "Aucun fichier sélectionné.", vbExclamation
        Exit Sub
    End If

    ' Créer une feuille temporaire pour stocker les données du CSV
    On Error Resume Next
    Set wsTemp = ThisWorkbook.Sheets("TempImport")
    If Not wsTemp Is Nothing Then
        Application.DisplayAlerts = False
        wsTemp.Delete
        Application.DisplayAlerts = True
    End If
    On Error GoTo 0

    Set wsTemp = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsTemp.Name = "TempImport"

    ' Ouvrir le fichier CSV avec l'encodage UTF-8
    Workbooks.OpenText Filename:=filePath, Origin:=65001, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True

    ' Référence au classeur CSV ouvert
    Set csvWorkbook = ActiveWorkbook

    ' Copier les données du fichier CSV vers la feuille temporaire
    csvWorkbook.Sheets(1).UsedRange.Copy Destination:=wsTemp.Cells(1, 1)

    ' Fermer le fichier CSV sans enregistrer
    csvWorkbook.Close SaveChanges:=False

    ' Continuer avec le reste du code de mise à jour en utilisant wsTemp pour les données
    Set wsMEEI = ThisWorkbook.Sheets(1)

    ' Déverrouiller toutes les cellules du classeur
    wsMEEI.Unprotect Password:="MEEI"
    Dim cell As Range
    For Each cell In wsMEEI.UsedRange
        cell.Locked = False
    Next cell

    Dim lastRowTemp As Long
    Dim lastRowMEEI As Long
    lastRowTemp = wsTemp.Cells(wsTemp.Rows.Count, "A").End(xlUp).Row
    lastRowMEEI = wsMEEI.Cells(wsMEEI.Rows.Count, "A").End(xlUp).Row

    ' Filtrer et copier les données pour "530 - Éclairage et luminosité"
    wsTemp.Range("A1:BX" & lastRowTemp).AutoFilter Field:=76, Criteria1:="530 - Éclairage et luminosité"
    CopyFilteredData wsTemp, wsMEEI, lastRowMEEI, "ECLAIRAGE"
    lastRowMEEI = wsMEEI.Cells(wsMEEI.Rows.Count, "A").End(xlUp).Row ' Mettre à jour lastRowMEEI

    ' Enlever le filtre
    wsTemp.AutoFilterMode = False

    ' Filtrer et copier les données pour "BAES"
    wsTemp.Range("A1:D" & lastRowTemp).AutoFilter Field:=4, Criteria1:="*BAES*"
    CopyFilteredData wsTemp, wsMEEI, lastRowMEEI, "BAES"
    lastRowMEEI = wsMEEI.Cells(wsMEEI.Rows.Count, "A").End(xlUp).Row ' Mettre à jour lastRowMEEI

    ' Enlever le filtre
    wsTemp.AutoFilterMode = False

    ' Adapter la taille des lignes au contenu
    wsMEEI.UsedRange.Rows.AutoFit

    ' Re-verrouiller les colonnes H et K
    wsMEEI.Columns("H").Locked = True
    wsMEEI.Columns("K").Locked = True

    ' Filtrer la colonne B pour masquer les cellules "Clos"
    wsMEEI.Range("A5:I" & lastRowMEEI).AutoFilter Field:=2, Criteria1:="<>Clos"

    ' Trier les valeurs par date dans la colonne C
    wsMEEI.Sort.SortFields.Clear
    wsMEEI.Sort.SortFields.Add Key:=wsMEEI.Range("C5:C" & lastRowMEEI), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wsMEEI.Sort
        .SetRange wsMEEI.Range("A5:I" & lastRowMEEI)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' Verrouiller les cellules utilisées des colonnes A à G
    Dim col As Long, Row As Long
    For col = 1 To 7
        For Row = 1 To lastRowMEEI
            If Not IsEmpty(wsMEEI.Cells(Row, col).Value) Then
                wsMEEI.Cells(Row, col).Locked = True
            End If
        Next Row
    Next col

    ' Protéger la feuille sans protéger la colonne I et J en permettant l'utilisation des filtres
    wsMEEI.Protect Password:="MEEI", UserInterfaceOnly:=True, AllowFiltering:=True
    wsMEEI.Columns("I:J").Locked = False

    ' Supprimer la feuille temporaire après la mise à jour
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
End Sub

Sub CopyFilteredData(wsSource As Worksheet, wsDest As Worksheet, ByRef lastRowDest As Long, category As String)
    Dim i As Long, j As Long
    Dim found As Boolean
    Dim lastRowSource As Long
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastRowSource
        If Not wsSource.Rows(i).Hidden Then
            found = False
            For j = 2 To lastRowDest
                If wsSource.Cells(i, 1).Value = wsDest.Cells(j, 1).Value Then
                    For col = 2 To 4
                        If wsSource.Cells(i, col).Value <> wsDest.Cells(j, col).Value Then
                            wsDest.Cells(j, col).Value = wsSource.Cells(i, col).Value
                            wsDest.Cells(j, col).Interior.Color = vbYellow
                        End If
                    Next col
                    If wsSource.Cells(i, 16).Value <> wsDest.Cells(j, 5).Value Then
                        wsDest.Cells(j, 5).Value = wsSource.Cells(i, 16).Value
                        wsDest.Cells(j, 5).Interior.Color = vbYellow
                    End If
                    If wsSource.Cells(i, 63).Value <> wsDest.Cells(j, 6).Value Then
                        wsDest.Cells(j, 6).Value = wsSource.Cells(i, 63).Value
                        wsDest.Cells(j, 7).Interior.Color = vbYellow
                    End If
                    found = True
                    Exit For
                End If
            Next j

            If Not found Then
                lastRowDest = lastRowDest + 1
                ' Copier les données avec les valeurs et les formats
                Dim colNum As Long
                For colNum = 1 To 4 ' Copier seulement les 4 premières colonnes
                    wsDest.Cells(lastRowDest, colNum).Value = wsSource.Cells(i, colNum).Value
                    wsDest.Cells(lastRowDest, colNum).NumberFormat = wsSource.Cells(i, colNum).NumberFormat
                Next colNum

                ' Ajouter la formule à la colonne G
                wsDest.Cells(lastRowDest, 7).Formula = "=IF(ISBLANK(F" & lastRowDest & "),"""",HYPERLINK(""https://action.cameleon-prod.edf.fr/actions/""&F" & lastRowDest & ",F" & lastRowDest & "))"

                ' Appliquer la mise en forme du lien hypertexte
                With wsDest.Cells(lastRowDest, 7).Font
                    .Color = RGB(0, 0, 255) ' Bleu
                    .Underline = xlUnderlineStyleSingle ' Souligné
                End With

                wsDest.Cells(lastRowDest, 9).Value = category
            End If
        End If
    Next i
End Sub

le code d'origine qui fonctionne parfaitement avec l'ouverture d'un fichier déjà en .xslx :

Sub UpdateMEEI()
    Dim wsExtraction As Worksheet
    Dim wsMEEI As Worksheet
    Dim lastRowExtraction As Long
    Dim lastRowMEEI As Long
    Dim extractionFile As Workbook
    Dim filePath As String

    ' Ouvrir une boîte de dialogue pour sélectionner le fichier extraction.xlsx
    filePath = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx", , "Sélectionnez le fichier extraction.xlsx")

    ' Vérifier si un fichier a été sélectionné
    If filePath = "Faux" Then
        MsgBox "Aucun fichier sélectionné.", vbExclamation
        Exit Sub
    End If

    ' Ouvrir le fichier sélectionné
    Set extractionFile = Workbooks.Open(filePath)
    Set wsExtraction = extractionFile.Sheets(1)
    Set wsMEEI = ThisWorkbook.Sheets(1)

    ' Déverrouiller toutes les cellules du classeur
    wsMEEI.Unprotect Password:="MEEI"
    For Each cell In wsMEEI.UsedRange
        cell.Locked = False
    Next cell

    lastRowExtraction = wsExtraction.Cells(wsExtraction.Rows.Count, "A").End(xlUp).Row
    lastRowMEEI = wsMEEI.Cells(wsMEEI.Rows.Count, "A").End(xlUp).Row

    ' Filtrer et copier les données pour "530 - Éclairage et luminosité"
    wsExtraction.Range("A1:BX" & lastRowExtraction).AutoFilter Field:=76, Criteria1:="530 - Éclairage et luminosité"
    CopyFilteredData wsExtraction, wsMEEI, lastRowMEEI, "ECLAIRAGE"
    lastRowMEEI = wsMEEI.Cells(wsMEEI.Rows.Count, "A").End(xlUp).Row ' Mettre à jour lastRowMEEI

    ' Enlever le filtre
    wsExtraction.AutoFilterMode = False

    ' Filtrer et copier les données pour "BAES"
    wsExtraction.Range("A1:D" & lastRowExtraction).AutoFilter Field:=4, Criteria1:="*BAES*"
    CopyFilteredData wsExtraction, wsMEEI, lastRowMEEI, "BAES"
    lastRowMEEI = wsMEEI.Cells(wsMEEI.Rows.Count, "A").End(xlUp).Row ' Mettre à jour lastRowMEEI

    ' Enlever le filtre
    wsExtraction.AutoFilterMode = False

    ' Adapter la taille des lignes au contenu
    wsMEEI.UsedRange.Rows.AutoFit

    ' Re-verrouiller les colonnes H et K
    wsMEEI.Columns("H").Locked = True
    wsMEEI.Columns("K").Locked = True

    ' Filtrer la colonne B pour masquer les cellules "Clos"
    wsMEEI.Range("A5:I" & lastRowMEEI).AutoFilter Field:=2, Criteria1:="<>Clos"

    ' Trier les valeurs par date dans la colonne C
    wsMEEI.Sort.SortFields.Clear
    wsMEEI.Sort.SortFields.Add Key:=wsMEEI.Range("C5:C" & lastRowMEEI), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wsMEEI.Sort
        .SetRange wsMEEI.Range("A5:I" & lastRowMEEI)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' Verrouiller les cellules utilisées des colonnes A à G
    For col = 1 To 7
        For Row = 1 To lastRowMEEI
            If Not IsEmpty(wsMEEI.Cells(Row, col).Value) Then
                wsMEEI.Cells(Row, col).Locked = True
            End If
        Next Row
    Next col

' Protéger la feuille sans protéger la colonne I et J en permettant l'utilisation des filtres
    wsMEEI.Protect Password:="MEEI", UserInterfaceOnly:=True, AllowFiltering:=True
    wsMEEI.Columns("I:J").Locked = False

    ' Fermer le fichier extraction.xlsx
    extractionFile.Close SaveChanges:=False

End Sub

Sub CopyFilteredData(wsSource As Worksheet, wsDest As Worksheet, ByRef lastRowDest As Long, category As String)
    Dim i As Long, j As Long
    Dim found As Boolean
    Dim lastRowSource As Long
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastRowSource
        If Not wsSource.Rows(i).Hidden Then
            found = False
            For j = 2 To lastRowDest
                If wsSource.Cells(i, 1).Value = wsDest.Cells(j, 1).Value Then
                    For col = 2 To 4
                        If wsSource.Cells(i, col).Value <> wsDest.Cells(j, col).Value Then
                            wsDest.Cells(j, col).Value = wsSource.Cells(i, col).Value
                            wsDest.Cells(j, col).Interior.Color = vbYellow
                        End If
                    Next col
                    If wsSource.Cells(i, 16).Value <> wsDest.Cells(j, 5).Value Then
                        wsDest.Cells(j, 5).Value = wsSource.Cells(i, 16).Value
                        wsDest.Cells(j, 5).Interior.Color = vbYellow
                    End If
                    If wsSource.Cells(i, 63).Value <> wsDest.Cells(j, 6).Value Then
                        wsDest.Cells(j, 6).Value = wsSource.Cells(i, 63).Value
                        wsDest.Cells(j, 7).Interior.Color = vbYellow
                    End If
                    found = True
                    Exit For
                End If
            Next j

            If Not found Then
                lastRowDest = lastRowDest + 1
                For col = 1 To 4
                    wsDest.Cells(lastRowDest, col).Value = wsSource.Cells(i, col).Value
                Next col
                wsDest.Cells(lastRowDest, 5).Value = wsSource.Cells(i, 16).Value
                wsDest.Cells(lastRowDest, 6).Value = wsSource.Cells(i, 63).Value

                ' Ajouter la formule à la colonne G
                wsDest.Cells(lastRowDest, 7).Formula = "=IF(ISBLANK(F" & lastRowDest & "),"""",HYPERLINK(""https://action.cameleon-prod.edf.fr/actions/""&F" & lastRowDest & ",F" & lastRowDest & "))"

                ' Appliquer la mise en forme du lien hypertexte
                With wsDest.Cells(lastRowDest, 7).Font
                    .Color = RGB(0, 0, 255) ' Bleu
                    .Underline = xlUnderlineStyleSingle ' Souligné
                End With

                wsDest.Cells(lastRowDest, 9).Value = category
            End If
        End If
    Next i
End Sub
Le 15/11/2024 à 04:14

Bonjour

Voir https://forum.excel-pratique.com/excel/a-lire-avant-de-poster-charte-du-forum-et-informations-utiles...

Paragraphe 4 de la première partie

Rechercher des sujets similaires à "mise jour fichier xlsm csv"