IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Macro save Excel en CSV


Sujet :

Macros et VBA Excel

  1. #1
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Mars 2010
    Messages
    51
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Mars 2010
    Messages : 51
    Points : 28
    Points
    28
    Par défaut Macro save Excel en CSV
    Bonjour,
    j'ai mon macro qui sauvegarde une de mes feuille excel en csv. Il marche bien mais dès que je fais mon sauvegarde, je perds mes derniers modification sur mon fichier excel.
    J'aimerai faire de sorte que le csv soit sauvegardé et que le fichier excel reste intacte et ne ferme pas.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
     
    Sub SaveCSV()
        Dim rep As String
        Dim Chemin As String, Fichier1 As String
        Chemin = dossier_cible & "\"
        Fichier1 = Range("A5").Value & "_" & Range("J1").Value & " " & Format(Date, "yyyy")
     
        Application.DisplayAlerts = False
        With ActiveWorkbook
        With ActiveSheet
          .Rows("1:3").Delete
         .SaveAs Filename:=Chemin & Fichier1 & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        End With
        MsgBox "Fichier sortie enregistré sous : " & dossier_cible & "\" & Fichier1
        End With
         Application.DisplayAlerts = True
    End Sub
    Merci d'avance.

  2. #2
    Invité
    Invité(e)
    Par défaut
    Bonjour,
    test ça
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    #If VBA7 Then
     Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
     Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
     Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, ByVal dwBytes As LongPtr) As Long
     Private Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
     Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As Long
     Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
     Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
     Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As Long
     Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
    #Else
     Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
     Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
     Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
     Private Declare Function CloseClipboard Lib "User32" () As Long
     Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
     Private Declare Function EmptyClipboard Lib "User32" () As Long
     Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
     Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
     Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
    #End If
    Private Const GHND = &H42
    Private Const CF_TEXT = 1
    Private Const MAXSIZE = 4096
     
    Sub test()
     
    Dim txt As String
    ActiveSheet.UsedRange.Copy
    txt = ClipBoard_GetData
    txt = Replace(txt, vbTab, ";")
     Chemin = ThisWorkbook.Path & "\" & ActiveSheet.Name & ".csv"
        Set fso = CreateObject("Scripting.FileSystemObject")
            Set NewFichier = fso.OpenTextFile(Chemin, 2, True)
            NewFichier.Write txt
            NewFichier.Close
            Set NewFichier = Nothing
        Set fso = Nothing
    End Sub
    Function ClipBoard_GetData() As String
       Dim hClipMemory As Long
       Dim lpClipMemory As Long
       Dim MyString As String
       Dim RetVal As Long
     
       If OpenClipboard(0&) = 0 Then
          MsgBox "Cannot open Clipboard. Another app. may have it open"
          Exit Function
       End If
     
       ' Obtain the handle to the global memory
       ' block that is referencing the text.
       hClipMemory = GetClipboardData(CF_TEXT)
       If IsNull(hClipMemory) Then
          MsgBox "Could not allocate memory"
          GoTo OutOfHere
       End If
     
       ' Lock Clipboard memory so we can reference
       ' the actual data string.
       lpClipMemory = GlobalLock(hClipMemory)
     
       If Not IsNull(lpClipMemory) Then
          MyString = Space$(MAXSIZE)
          RetVal = lstrcpy(MyString, lpClipMemory)
          RetVal = GlobalUnlock(hClipMemory)
     
          ' Peel off the null terminating character.
          MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
       Else
          MsgBox "Could not lock memory to copy string from."
       End If
     
    OutOfHere:
     
       RetVal = CloseClipboard()
       ClipBoard_GetData = MyString
     
    End Function

  3. #3
    Membre éprouvé
    Profil pro
    Inscrit en
    Juin 2009
    Messages
    652
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juin 2009
    Messages : 652
    Points : 1 219
    Points
    1 219
    Par défaut
    Bonjour,

    Peut être comme cela
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
     
    Sub SaveCSV()
        Dim rep As String
        Dim Chemin As String, Fichier1 As String
        Chemin = dossier_cible & "\"
        Fichier1 = Range("A5").Value & "_" & Range("J1").Value & " " & Format(Date, "yyyy")
     
    '--- Fait une copie temporaire du classeur d'origine ---
    Dim WB As Workbook
    ActiveWorkbook.SaveCopyAs Chemin & Fichier1 & ".xlsm"
    Set WB = Workbooks.Open(Chemin & Fichier1 & ".xlsm")
    '--------------------------------------------------------
     
        '--- Le traitement s'applique sur la copie temporaire du classeur d'origine ---
        Application.DisplayAlerts = False
        With WB
        With WB.ActiveSheet
          .Rows("1:3").Delete
         .SaveAs Filename:=Chemin & Fichier1 & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        End With
        MsgBox "Fichier sortie enregistré sous : " & dossier_cible & "\" & Fichier1
        End With
         Application.DisplayAlerts = True
        '-------------------------------------------------------------------------------
     
    '--- Détruit la copie temporaire du classeur d'origine ---
    WB.Close savechanges:=False
    Set WB = Nothing
    Kill Chemin & Fichier1 & ".xlsm"
    '---------------------------------------------------------
     
    End Sub

  4. #4
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Mars 2010
    Messages
    51
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Mars 2010
    Messages : 51
    Points : 28
    Points
    28
    Par défaut
    Bonjour
    PMO2017
    Bonjour,
    Peut être comme cela
    ,
    ta solution semble marcher.
    Merci bien .

  5. #5
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Mars 2010
    Messages
    51
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Mars 2010
    Messages : 51
    Points : 28
    Points
    28
    Par défaut
    Bonjour,
    il se trouve que mon application a une page d'accueil et dès que je lance le macro SaveCSV il fait le travail nikel mais par contre au lieu sur la feuille d'origine, il affiche la page d'accueil.
    Existe il une solution pour résoudre ce problème ? j'ai essayé de bidouiller mais rien.
    Merci par avance.

  6. #6
    Membre éprouvé
    Profil pro
    Inscrit en
    Juin 2009
    Messages
    652
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juin 2009
    Messages : 652
    Points : 1 219
    Points
    1 219
    Par défaut
    Bonjour,

    Alors peut être comme cela (voir les ###)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    Sub SaveCSV()
        Dim rep As String
        Dim Chemin As String, Fichier1 As String
        Chemin = dossier_cible & "\"
        Fichier1 = Range("A5").Value & "_" & Range("J1").Value & " " & Format(Date, "yyyy")
     
    '--- Fait une copie temporaire du classeur d'origine ---
    Dim WB As Workbook
    ActiveWorkbook.SaveCopyAs Chemin & Fichier1 & ".xlsm"
    Set WB = Workbooks.Open(Chemin & Fichier1 & ".xlsm")
    '--------------------------------------------------------
     
     
    '#### On séléctionne la bonne feuille qui devient active (ActiveSheet)
    WB.Sheets("Nom de la bonne feuille").Select 'adapter du nom de la bonne feuille
    '####
     
        '--- Le traitement s'applique sur la copie temporaire du classeur d'origine ---
        Application.DisplayAlerts = False
        With WB
     
        With WB.ActiveSheet   '###
     
          .Rows("1:3").Delete
         .SaveAs Filename:=Chemin & Fichier1 & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        End With
        MsgBox "Fichier sortie enregistré sous : " & dossier_cible & "\" & Fichier1
        End With
         Application.DisplayAlerts = True
        '-------------------------------------------------------------------------------
     
    '--- Détruit la copie temporaire du classeur d'origine ---
    WB.Close savechanges:=False
    Set WB = Nothing
    Kill Chemin & Fichier1 & ".xlsm"
    '---------------------------------------------------------
     
    End Sub

  7. #7
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Mars 2010
    Messages
    51
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Mars 2010
    Messages : 51
    Points : 28
    Points
    28
    Par défaut
    Bonjour,
    j'ai essayé ta suggestion mais il fait toujours la même chose. Après la sauvegarde impossible de revenir directement sur la feuille en question.

  8. #8
    Invité
    Invité(e)
    Par défaut
    Bonjour,
    ça: '--- Fait une copie temporaire du classeur d'origine --- j'ai pas compris!
    ????? Set WB = Workbooks.Open(Chemin & Fichier1 & ".xlsm") il est déjà ouvert non?

    ça '#### On séléctionne la bonne feuille qui devient active (ActiveSheet) dans la mesure du possible pas de sélection!

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    #If VBA7 Then
     Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
     Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
     Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, ByVal dwBytes As LongPtr) As Long
     Private Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
     Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As Long
     Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
     Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
     Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As Long
     Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
    #Else
     Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
     Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
     Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
     Private Declare Function CloseClipboard Lib "User32" () As Long
     Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
     Private Declare Function EmptyClipboard Lib "User32" () As Long
     Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
     Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
     Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
    #End If
    Private Const GHND = &H42
    Private Const CF_TEXT = 1
    Private Const MAXSIZE = 4096
     
    Sub SaveCSV()
    Dim Fichier1 As String
     Fichier1 = dossier_cible & "\" & Range("A5").Value & "_" & Range("J1").Value & " " & Format(Date, "yyyy")
    Dim txt As String
    ActiveWorkbook.Sheets("Nom de la bonne feuille").Rows("1:3").Delete
    ActiveWorkbook.Sheets("Nom de la bonne feuille").UsedRange.Copy
    txt = ClipBoard_GetData
    txt = Replace(txt, vbTab, ";")
     
        Set fso = CreateObject("Scripting.FileSystemObject")
            Set NewFichier = fso.OpenTextFile(Fichier1, 2, True)
            NewFichier.Write txt
            NewFichier.Close
            Set NewFichier = Nothing
        Set fso = Nothing
    End Sub
    Function ClipBoard_GetData() As String
       Dim hClipMemory As Long
       Dim lpClipMemory As Long
       Dim MyString As String
       Dim RetVal As Long
     
       If OpenClipboard(0&) = 0 Then
          MsgBox "Cannot open Clipboard. Another app. may have it open"
          Exit Function
       End If
     
       ' Obtain the handle to the global memory
       ' block that is referencing the text.
       hClipMemory = GetClipboardData(CF_TEXT)
       If IsNull(hClipMemory) Then
          MsgBox "Could not allocate memory"
          GoTo OutOfHere
       End If
     
       ' Lock Clipboard memory so we can reference
       ' the actual data string.
       lpClipMemory = GlobalLock(hClipMemory)
     
       If Not IsNull(lpClipMemory) Then
          MyString = Space$(MAXSIZE)
          RetVal = lstrcpy(MyString, lpClipMemory)
          RetVal = GlobalUnlock(hClipMemory)
     
          ' Peel off the null terminating character.
          MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
       Else
          MsgBox "Could not lock memory to copy string from."
       End If
     
    OutOfHere:
     
       RetVal = CloseClipboard()
       ClipBoard_GetData = MyString
     
    End Function

  9. #9
    Membre éprouvé
    Profil pro
    Inscrit en
    Juin 2009
    Messages
    652
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juin 2009
    Messages : 652
    Points : 1 219
    Points
    1 219
    Par défaut
    il fait le travail nikel mais par contre au lieu sur la feuille d'origine, il affiche la page d'accueil.
    Il manque un mot dans cette phrase. J'avais une chance sur 2, il s'agit soit du classeur copie soit de celui d'origine.
    Le code suivant agit sur les 2 classeurs ce qui évite tout problème
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    Sub SaveCSV()
        Dim rep As String
        Dim Chemin As String, Fichier1 As String
        Chemin = dossier_cible & "\"
        Fichier1 = Range("A5").Value & "_" & Range("J1").Value & " " & Format(Date, "yyyy")
     
    '--- Fait une copie temporaire du classeur d'origine ---
    Dim WB As Workbook
    ActiveWorkbook.SaveCopyAs Chemin & Fichier1 & ".xlsm"
    Set WB = Workbooks.Open(Chemin & Fichier1 & ".xlsm")
    '--------------------------------------------------------
     
    '#### C'est le classeur COPIE
    '#### On séléctionne la bonne feuille qui devient active (ActiveSheet)
    WB.Sheets("Nom de la bonne feuille").Select 'adapter du nom de la bonne feuille
    '####
     
        '--- Le traitement s'applique sur la copie temporaire du classeur d'origine ---
        Application.DisplayAlerts = False
        With WB
     
        With WB.ActiveSheet   '###
     
          .Rows("1:3").Delete
         .SaveAs Filename:=Chemin & Fichier1 & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        End With
        MsgBox "Fichier sortie enregistré sous : " & dossier_cible & "\" & Fichier1
        End With
         Application.DisplayAlerts = True
        '-------------------------------------------------------------------------------
     
    '--- Détruit la copie temporaire du classeur d'origine ---
    WB.Close savechanges:=False
    Set WB = Nothing
    Kill Chemin & Fichier1 & ".xlsm"
    '---------------------------------------------------------
     
    '#### Là, c'est le classeur d'ORIGINE
    '#### On séléctionne la bonne feuille qui devient active
    ActiveWorkbook.Sheets("Nom de la bonne feuille").Select 'adapter du nom de la bonne feuille
    '####
     
    End Sub
    ********************
    Salut rdurupt,
    Bonjour,
    ça: '--- Fait une copie temporaire du classeur d'origine --- j'ai pas compris!
    ????? Set WB = Workbooks.Open(Chemin & Fichier1 & ".xlsm") il est déjà ouvert non?
    Tu oublies une ligne de code importante, celle qui crée la copie. Il faut lire
    '--- Fait une copie temporaire du classeur d'origine ---
    Dim WB As Workbook
    ActiveWorkbook.SaveCopyAs Chemin & Fichier1 & ".xlsm"
    Set WB = Workbooks.Open(Chemin & Fichier1 & ".xlsm")
    '--------------------------------------------------------

  10. #10
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Mars 2010
    Messages
    51
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Mars 2010
    Messages : 51
    Points : 28
    Points
    28
    Par défaut
    rebonjour,
    tout d’abord désolé pour la phrase incomplète
    il fait le travail nikel mais par contre au lieu sur la feuille d'origine, il affiche la page d'accueil.
    au lieu de retourner sur la feuille d'origine
    J'ai adapté au mieux ta solution et cette fois ci je vous mets le fichier excel en pj avec le macro car cela vas te permettre de mieux comprendre.
    Merci...
    Fichiers attachés Fichiers attachés

  11. #11
    Invité
    Invité(e)
    Par défaut
    Tu oublies une ligne de code importante, celle qui crée la copie. Il faut lire
    J'ai relu plusieurs fois et je ne vois rien qui justifie une sauvegarde temporaire!

    Bonjour,
    j'ai mon macro qui sauvegarde une de mes feuille excel en csv. Il marche bien mais dès que je fais mon sauvegarde, je perds mes derniers modification sur mon fichier excel.
    J'aimerai faire de sorte que le csv soit sauvegardé et que le fichier excel reste intacte et ne ferme pas.
    Je me contente d'apporter mon aide pas de fournir une solution 100% confirme à la demande!
    Ce qui m'importe c'est que le résulta soit conforme.

    si tu regarde mon code tu verras que je ne sauvegarde pas le fichier Excel en CSV mais je récupère le contenu de la l'onglet dans un variable String et que je la sauvegarde dans un fichier via FSO!

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    Sub SaveCSV()
    Dim Fichier1 As String
     Fichier1 = dossier_cible & "\" & Range("A5").Value & "_" & Range("J1").Value & " " & Format(Date, "yyyy")
    Dim txt As String
    ActiveWorkbook.Sheets("Nom de la bonne feuille").Rows("1:3").Delete
    ActiveWorkbook.Sheets("Nom de la bonne feuille").UsedRange.Copy
    txt = ClipBoard_GetData
    txt = Replace(txt, vbTab, ";")
     
        Set fso = CreateObject("Scripting.FileSystemObject")
            Set NewFichier = fso.OpenTextFile(Fichier1, 2, True)
            NewFichier.Write txt
            NewFichier.Close
            Set NewFichier = Nothing
        Set fso = Nothing
    End Sub
    Dernière modification par Invité ; 03/07/2015 à 12h52.

  12. #12
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Mars 2010
    Messages
    51
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Mars 2010
    Messages : 51
    Points : 28
    Points
    28
    Par défaut
    rdurupt
    Je me contente d'apporter mon aide pas de fournir une solution 100% confirme à la demande!
    Ce qui m'importe c'est que le résulta soit conforme.
    J'ai bien ton raisonnement et j'ai essayé ta dernière solution mais ça ne marche pas.
    Essaie le vc le fichier que j'ai fourni pour voir.

  13. #13
    Invité
    Invité(e)
    Par défaut
    Bonjour,
    voila ma version!
    Fichiers attachés Fichiers attachés

  14. #14
    Membre émérite
    Inscrit en
    Octobre 2010
    Messages
    1 401
    Détails du profil
    Informations forums :
    Inscription : Octobre 2010
    Messages : 1 401
    Points : 2 684
    Points
    2 684
    Par défaut
    Bonjour à tous.

    Je suggère une autre méthode qui est celle-ci:
    - Créer un nouveau classeur avec Workbooks.Add
    - Utiliser le paramètre local:=True de la commande SaveAs pour choisir le séparateur de liste local.


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    Sub SaveAs_Local()
     
        Dim Nom As String
        Dim Chemin As String
        Dim shOrigine As Worksheet
        Dim WbDest As Workbook
     
        Set shOrigine = ActiveSheet
     
        dossier_cible = ThisWorkbook.Path
     
        Chemin = dossier_cible
     
        Nom = shOrigine.Range("A5").Value & "_" & shOrigine.Range("J1").Value & " " & Format(Date, "yyyy")
     
        Set WbDest = Workbooks.Add
     
        shOrigine.Copy Before:=WbDest.Sheets(1)
     
        WbDest.Sheets(1).Rows("1:3").Delete
     
        WbDest.SaveAs Filename:=Chemin & "\" & Nom & ".csv", FileFormat:=xlCSV, CreateBackup:=False, local:=True
     
     
    End Sub
    Cordialement

    Docmarti.

Discussions similaires

  1. Save Excel en csv VBA
    Par khech dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 26/06/2015, 12h43
  2. Macro Conversion fichier excel en .csv
    Par Tomz57 dans le forum Macros et VBA Excel
    Réponses: 14
    Dernier message: 16/04/2015, 11h46
  3. [VBA-E] macro conversion excel vers csv
    Par abdelhamidem dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 13/10/2008, 17h48
  4. Macro dans excel permettant de voir si un fichier est ouvert
    Par VirginieGE dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 12/08/2004, 08h51
  5. [VBA-E] macro conversion excel vers csv
    Par baboune dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 15/07/2004, 10h23

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo