Code VBA pour enregistrer des fichiers xls en xlsx

Le 01/12/2022 à 14:47

Bonjour,

J'ai un petit souci avec une macro que je veux écrire. Elle est très basique (comme mon niveau en VBA) et sûrement pas optimale mais elle fonctionne. Mon seul problème est qu'à la fin j'aimerais qu'elle enregistre mes fichiers en format xlsx et non au format xls qu'ils ont de base. J'ai essayé plusieurs solutions en farfouillant sur différents forums mais tout ce que j'ai réussi à faire c'est à les enregistrer au format ".xls.xlsx". Je n'arrive pas à me débarrasser de ce .xls. Pouvez-vous m'aider s'il vous plaît?

De base mes fichiers sont extraits d'un logiciel de gestion de ressources humaines et sortent sous cette forme: "cetpercpta.594.20221124103136.01712594", c'est nous qui modifions l'extension en xls (devient donc: cetpercpta.xls) pour ensuite pouvoir les ouvrir dans Excel. Est-il possible qu'une macro transforme cette extension directement en xls ou encore mieux en xlsx?

Sub OuvertureTousClasseurs()

Dim mois

'Récupération dans des variables des informations saisies dans des boîtes de dialogue
 mois = InputBox("Saisir la période ciblée (Exemple: 01_Janvier pour janvier)") ' Enregistre dans la variable Mois le contenu d'une boîte de saisie

'Étape 1: Déclaration des variables
Dim MesFichiers As String
'Étape 2: Indication du répertoire cible
MesFichiers = Dir("\\W11590400SAV\Pilotage\Budget\2022\01_GA\01_Frais_de_personnel\Produits_GRH\Dossier test\11_Novembre\*.xls")
Do While MesFichiers <> ""
'Étape 3: Ouvre tous les classeurs
Workbooks.Open "\\W11590400SAV\Pilotage\Budget\2022\01_GA\01_Frais_de_personnel\Produits_GRH\Dossier test\11_Novembre\" & MesFichiers
'Etape 4: Exécution du code et enregistrement du fichier
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), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
ActiveWorkbook.SaveAs Filename:="\\W11590400SAV\Pilotage\Budget\2022\01_GA\01_Frais_de_personnel\Produits_GRH\" & mois & "\" & MesFichiers 'FileFormat:=xlOpenXMLWorkbook

ActiveWorkbook.Close SaveChanges:=False

'Étape 5: Répète avec les fichiers suivants du dossier
MesFichiers = Dir
Loop

Application.DisplayAlerts = False
Application.Quit
ActiveWorkbook.Close True
Application.DisplayAlerts = True

End Sub

Merci d'avance pour l'aide que vous pourrez m'apporter

Le 01/12/2022 à 16:58

Bonjour,

Je crois que vous avez mis la partie du code en commentaires :

Sub OuvertureTousClasseurs()

Dim mois

'Récupération dans des variables des informations saisies dans des boîtes de dialogue
 mois = InputBox("Saisir la période ciblée (Exemple: 01_Janvier pour janvier)") ' Enregistre dans la variable Mois le contenu d'une boîte de saisie

'Étape 1: Déclaration des variables
Dim MesFichiers As String
'Étape 2: Indication du répertoire cible
MesFichiers = Dir("\\W11590400SAV\Pilotage\Budget\2022\01_GA\01_Frais_de_personnel\Produits_GRH\Dossier test\11_Novembre\*.xls")
Do While MesFichiers <> ""
'Étape 3: Ouvre tous les classeurs
Workbooks.Open "\\W11590400SAV\Pilotage\Budget\2022\01_GA\01_Frais_de_personnel\Produits_GRH\Dossier test\11_Novembre\" & MesFichiers
'Etape 4: Exécution du code et enregistrement du fichier
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), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
ActiveWorkbook.SaveAs Filename:="\\W11590400SAV\Pilotage\Budget\2022\01_GA\01_Frais_de_personnel\Produits_GRH\" & mois & "\" & MesFichiers, FileFormat:=xlOpenXMLWorkbook '<<<<ICI

ActiveWorkbook.Close SaveChanges:=False

'Étape 5: Répète avec les fichiers suivants du dossier
MesFichiers = Dir
Loop

Application.DisplayAlerts = False
Application.Quit
ActiveWorkbook.Close True
Application.DisplayAlerts = True

End Sub

Voici un lien qui énumère les formats :

https://learn.microsoft.com/fr-fr/office/vba/api/excel.xlfileformat

et

xlOpenXMLWorkbook

est la valeur à définir pour obtenir un classeur .xlsx.

Cdlt,

Le 02/12/2022 à 09:08

Bonjour,

Merci pour votre réponse. En effet je l'avais mise en commentaire le temps de tester autre chose, mais même en la remettant en code, mes fichier ne s'enregistre pas en xlsx. Ils gardent leur format d'origine. J'avais déjà essayé xlOpenXMLWorkbook et même xlOpenXMLStrictWorkbook pour avoir l'extension xlsx mais cela ne fonctionne pas. Il doit y avoir une partie de code qui bloque dans ma macro.

Le 02/12/2022 à 09:42

Bonjour

A tout hasard

Sortir .xls du nom MesFichiers

MonFichiera= "=LEFT(MesFichiers,FIND(""."";MesFichiers)-1)" & ".xlsx"

Utiliser ce nom dans enregistrer sous

A tester

FINDRH

Le 03/12/2022 à 10:26

Bonjour à tous,

Voici une tentative d'adaptation du code qui tient compte de la remarque de FINDRH :

Sub OuvertureTousClasseurs()
Dim mois, sPath as string, sCurrentFile As String, sNewFilename as string
'Récupération dans des variables des informations saisies dans des boîtes de dialogue
mois = InputBox("Saisir la période ciblée (Exemple: 01_Janvier pour janvier)") ' Enregistre dans la variable Mois le contenu d'une boîte de saisie
sPath = "\\W11590400SAV\Pilotage\Budget\2022\01_GA\01_Frais_de_personnel\Produits_GRH\Dossier test\" & mois
sCurrentFile = Dir(sPath & "\*.xls")
Do While sCurrentFile <> ""
    with Workbooks.Open(sPath & "\" & sCurrentFile)
        with .sheets(1).Columns(1)
            .TextToColumns Destination:=.cells(1, 1), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Other:=True, _
                OtherChar:="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
                Array(6, 1), Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
        end with
        sNewFilename = replace(sCurrentFile, ".xls", ".xlsx")
        .SaveAs Filename:=sNewFilename, FileFormat:=xlOpenXMLWorkbook
        .Close
    end with
    sCurrentFile = Dir
Loop
'Application.DisplayAlerts = False
'Application.Quit
'ActiveWorkbook.Close True
'Application.DisplayAlerts = True
End Sub

Aussi, j'ai apporté un changement car j'ai remarqué que le chemin de départ était inscrit en dur dans le code malgré le recours à la boite de dialogue qui alimente la variable mois. Du coup, j'ai variabilisé le répertoire dont on parcourt les fichiers .xls en fonction du mois renseigné dans l'Inputbox.

Aussi, plutôt qu'une inputbox, j'aurais tendance à privilégier un userform avec juste une listbox simple qui liste les 12 mois de l'année pour faciliter la sélection du mois à traiter.

Cdlt,

Le 09/12/2022 à 15:36

Bonjour,

Merci beaucoup pour votre aide. J'ai essayé de faire par moi-même ce que disait FINDRH mais je n'ai pas réussi. En revanche votre code 3GB fonctionne très bien.
Le chemin de départ était en dur car le dossier test est provisoire et ne correspondait pas au mois renseigné dans l'inputbox pour le moment. Le userform peut-être intéressant en effet, je vais tester.

Je me permets de remettre ici une question que je posais et qui pourrait nous faire gagner encore plus de temps: De base les fichiers sont extraits d'un logiciel de gestion de ressources humaines et sortent sous cette forme: "cetpercpta.594.20221124103136.01712594", c'est nous qui modifions l'extension en .xls (devient donc: cetpercpta.xls) pour ensuite pouvoir les ouvrir dans Excel puis les mettre en forme. On fait cela manuellement pour une trentaine de fichiers... Est-il possible qu'une macro transforme cette extension directement en .xls ou encore mieux en .xlsx?

Merci par avance et bon week-end!

Le 09/12/2022 à 16:19

Bonjour,

Et quel est le format du fichier brut ? Est-ce un fichier texte ?

En tout cas, il faut faire des tests mais je pense que c'est possible.

D'ailleurs, il semble possible de sonder 30 fichiers pour en créer un seul avec 30 onglets.

Cdlt,

Le 19/12/2022 à 15:48

Bonjour,

Je vous avoue que je ne sais pas, on ne peut pas l'ouvrir sans modifier l'extension.

capture2 capture

Merci,

Cordialement

Rechercher des sujets similaires à "code vba enregistrer fichiers xls xlsx"