Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Bastien43

XLDnaute Occasionnel
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
 

Pièces jointes

  • CPT_MG_Jallais_CROIX_CHANTE-DEBIT_DISTRIBUEm3h_2021-07-20_2021-07-27_1211635999.xls
    24.5 KB · Affichages: 11
  • CPT_MG_Jallais_POIRONNIERE-DEBIT_DISTRIBUEm3h_2021-07-20_2021-07-27_1548562673.xls
    24.5 KB · Affichages: 5
Dernière édition:
Solution
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...

patricktoulon

XLDnaute Barbatruc
Bonjour
il y avait quelque erreurs dans ton code
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

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

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
 

patricktoulon

XLDnaute Barbatruc
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…