XL 2019 Suppression caractères fin de noms fichiers excel - Problème chemin accès

Bastien43 · 23 Août 2021

Bonjour,

Je souhaite supprimer les 35 derniers caractères de plusieurs fichiers excel.

J'ai créé cette macro en permettant la sélection du dossier qui contient les fichiers. Cependant, je n'arrive pas "à fixer" le chemin d'accès pour renommer.

Voici la macro. Je transmets 2 fichiers en exemple.

Peut-être ajouter un "return" dans la fonction, qui récupère le chemin d'accès ?

VB:

Sub Suppresion_fin_caractères()

   Dim NomFic As String, Wbk As Workbook
   Dim Texte As String
 
   If MsgBox("Simplifier les noms des fichiers ?", vbYesNo) = vbNo Then Exit Sub
   ChDrive "C": ChDir Selection_Dossier
   NomFic = Dir("*.xl*")
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   NbFic = 0

    Do While NomFic <> ""
        NbFic = NbFic + 1
        Texte = Left(NomFic, Len(NomFic) - 35)
        Texte = Texte & ".xls"
        Name NomFic As Selection_Dossier & "\" & Texte      'La difficulté est ici
        NomFic = Dir: Loop
       
MsgBox ("Tous les " & NbFic & " noms des fichiers du dossier sélectionné ont été simplifiés !")

End Sub

Function Selection_Dossier() As Variant

    With Application.FileDialog(4)

        .Show
        On Error Resume Next
        Selection_Dossier = .SelectedItems(1)
        If Err.Number <> 0 Then Selection_Dossier = False

    End With

End Function

patricktoulon · 23 Août 2021

re!!!!
et encore j'ai zappé une autre erreur très importante!!!!!!!
il n'est pas forcé que ca soit des "xls" ca peut etre des "xlsx" ou "xlsm" etc....
et ca dans la boucle ditr il n'y a pas de distinction
et tu risque de sauver en "xls" des xls(x) ou( m) c'est pas JOJO
il te faut donc déterminer l’extension de fichier au lieu de penser que c'est a tout les coup des "xls"

donc on corrige ça comme suit

VB:

Sub Suppresion_fin_caractères()

    Dim NomFic$, Wbk As Workbook, Texte$, dossier$, Ext$

    If MsgBox("Simplifier les noms des fichiers ?", vbYesNo) = vbNo Then Exit Sub
    ChDrive "C": dossier = GetFolder: ChDir dossier
    If dossier = "" Then Exit Sub    ' si on a annulé dans le dialog on sort
    With Application...

Bastien43 · 23 Août 2021

Bon en fait j'ai juste mis :

Name NomFic As Texte

et cela fonctionne

Merci

patricktoulon · 23 Août 2021

Bonjour
il y avait quelque erreurs dans ton code
1° par exemple ton dialog folder était ra pellé forcement car tu l'utilise comme fonction et variable

2°le dir doit se faire sur un chemin et non un nom de fichier ou une partie
tout du moins le chemin dossier doit etre complet sauf mode boucle récursive de dir

3° le names As doit aussi contenir le chemin de depart et celui de sortie

4°alors bien que perso j'aurais compiler les chemins de fichier dans une variable tableau pour ensuite les renommer avec name , j'ai laissé le renommage direct dans la boucle dir mais c'est pas très prudent tu fait pédaler le dir pour rien

donc

VB:

Sub Suppresion_fin_caractères()

    Dim NomFic$, Wbk As Workbook, Texte$, dossier$

    If MsgBox("Simplifier les noms des fichiers ?", vbYesNo) = vbNo Then Exit Sub
    ChDrive "C": dossier = GetFolder: ChDir dossier
    If dossier = "" Then Exit Sub    ' si on a annulé dans le dialog on sort
    With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
    NbFic = 0
    NomFic = Dir(dossier & "\*.xl*")    'le dir se fait avec un chemein complet  meme avec les asterisques

    Do While NomFic <> ""
        NbFic = NbFic + 1
        If Len(NomFic) > 35 Then
            Texte = Left(NomFic, Len(NomFic) - 35)
            Texte = Texte & ".xls"
            Name dossier & "\" & NomFic As dossier & "\" & Texte     'La difficulté est ici
        End If
        NomFic = Dir
    Loop

    MsgBox ("Tous les " & NbFic & " noms des fichiers du dossier sélectionné ont été simplifiés !")

End Sub

Function GetFolder() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then GetFolder = .SelectedItems(1) Else GetFolder = ""
    End With
End Function

Bastien43 · 23 Août 2021

Bonjour,

Merci pour les explications. Effectivement la macro est plus claire et l'écriture est meilleurs

Merci pour votre retour et votre temps.

Cordialement
Bastien

patricktoulon · 23 Août 2021

re!!!!
et encore j'ai zappé une autre erreur très importante!!!!!!!
il n'est pas forcé que ca soit des "xls" ca peut etre des "xlsx" ou "xlsm" etc....
et ca dans la boucle ditr il n'y a pas de distinction
et tu risque de sauver en "xls" des xls(x) ou( m) c'est pas JOJO
il te faut donc déterminer l’extension de fichier au lieu de penser que c'est a tout les coup des "xls"

donc on corrige ça comme suit

VB:

Sub Suppresion_fin_caractères()

    Dim NomFic$, Wbk As Workbook, Texte$, dossier$, Ext$

    If MsgBox("Simplifier les noms des fichiers ?", vbYesNo) = vbNo Then Exit Sub
    ChDrive "C": dossier = GetFolder: ChDir dossier
    If dossier = "" Then Exit Sub    ' si on a annulé dans le dialog on sort
    With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
    NbFic = 0
    NomFic = Dir(dossier & "\*.xl*")    'le dir se fait avec un chemein complet  meme avec les asterisques

    Do While NomFic <> ""
        NbFic = NbFic + 1
        Ext = Mid(NomFic, InStrRev(NomFic, "."))
        If Len(NomFic) > 35 Then
            Texte = Left(NomFic, Len(NomFic) - 35)
            Texte = Texte & Ext
            Name dossier & "\" & NomFic As dossier & "\" & Texte     'La difficulté est ici
        End If
        NomFic = Dir
    Loop

    MsgBox ("Tous les " & NbFic & " noms des fichiers du dossier sélectionné ont été simplifiés !")

End Sub

Function GetFolder() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then GetFolder = .SelectedItems(1) Else GetFolder = ""
    End With

End Function

voila maintenant c'est mieux

Bastien43 · 23 Août 2021

encore merci pour les corrections et améliorations

XL 2019 Suppression caractères fin de noms fichiers excel - Problème chemin accès

Bastien43

XLDnaute Occasionnel

Pièces jointes

patricktoulon

Bastien43

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Bastien43

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Bastien43

XLDnaute Occasionnel

Discussions similaires