script pour renommer fichier

**RyuAutodidacte** · 20/03/2017, 22h11

re,
je crois que cette réponse concerne le test du chemin avec Workbooks.open quand il l'a testé la 1ère fois;
mais sait on jamais c'est peut être sur le code que tu lui as fourni qu'il doit corriger.
attendons qu'il se prononce pour en savoir plus

Edit : Il l'a re-testé, c'est OK maintenant

**RyuAutodidacte** · 22/03/2017, 10h45

Bonjour hugoashka,

As tu testé le code de @parmi sur PC en ayant pris soin de reporter la correction qu'il t'as fourni ??

Pour ma part la solution pour Mac avance, mais prends un peu plus de temps car c'est une solution globale
qui permet de prendre en compte n'importe quelles extensions et donc n'importe quels type de fichiers
(Pas besoin d'indiquer une extension)
Donc c'est surtout la partie script que je suis en train de travailler et non vba.

Sinon la version vba pour Mac est assez proche de la version PC à peu de choses près en partant du principe que toutes les images soient au même format.
Donc plus rapide à faire.

PS : J'ai pas très bien compris où tu voulais en venir avec de 1 à 10 puis de 11 à 15 etc
On ne traite pas tout d'un seul coup selon le nom de l'image avec ancien nom => nouveau nom ??

**RyuAutodidacte** · 27/03/2017, 05h18

Bonjour,

Voilà une version Mac pour le nommage des noms de fichiers pour Excel 2011 et 2016 et +

PS : je n'ai pas pu tester sur la version 2016 Mac que je n'ai pas => j'ai fait mes tests autrement donc à confirmer svp

Attention dans le code voir le remplissage des constantes => à paraméter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Const FormatF = "" 'Format du fichier ex : "jpg" ou "pdf" … => si tout les fichiers à renommer ont le même format - sinon laisser à vide
Const Col_Nom = 2: Const Entete = 0: Const Decal_Col = 4

Const FormatF = "" => si tout les fichiers à renommer ont le même format à remplir - ex : "jpg" ou "pdf" … ||=> sinon laisser à vide
Const Col_Nom = 2 => correspond à la colonne des noms actuels
Const Entete = 0 => correspond au nombre de ligne de la têtière
Const Decal_Col = 4 => correspond à la colonne des nouveaux noms par décalage à la colonne des noms actuels

À savoir : si Col_Nom = 2 (Noms actuels) donc en colonne B, les nouveaux noms devront être sur la colonne suivante donc ici la colonne C
Pour avoir les nouveaux noms dans le fichier Excel mettre un décalage dans Const Decal_Col par rapport à Const Col_Nom
Ex : si on a les noms actuels en col B et que l'on fait un décalage de 4, les nouveaux noms seront mis en colonne F
Const Col_Nom = 2 => Col B \ | / Const Decal_Col = 4 => Col F (2+4)

Le choix du dossier source est fait par le code qui demande de choisir le dossier concerné

le code :

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
Sub RenommerFichiers()
Const FormatF = "" 'Format du fichier ex : "jpg" ou "pdf" … => si tout les fichiers à renommer ont le même format - sinon laisser à vide
Const Col_Nom = 2: Const Entete = 0: Const Decal_Col = 4
Dim VA, VB(), Dossier$, DossierAS$, DL&, i&, VBAList$, MonScript$, NomD$
    '---------------------------------------------------------------------------------------------------------
    ' Détection si le code est utilisé sur un Mac puis détecte la version d'Excel (pour Excel 2011 - 2016)
    VApp = Val(Application.Version)
    #If Mac Then
        If VApp > 15 Then _
            Dossier = MacScript("tell application ""Finder"" to POSIX path of (choose folder) as Unicode text") Else _
            Dossier = MacScript("(choose folder) as Unicode text"): _
            DossierAS = MacScript("tell application ""Finder"" to POSIX path of " & Chr(34) & Dossier & Chr(34) & " as Unicode text")
    #Else
        MsgBox "Ce code est conçu pour Excel Mac 2011, 2016 et +": Exit Sub
    #End If
 
    DL = Cells(Rows.Count, Col_Nom).End(xlUp).Row
    VA = Range(Cells(1 + Entete, Col_Nom), Cells(DL, Col_Nom + 1)).Value
 
    ReDim VB(1 To UBound(VA), 1 To 1)
 
        If FormatF = "" Then
 
            '---------------------------------------------------------------------------------------------------------
            ' Partie de code lorsque le format du fichier n'est pas connu à l'avance , dans ce cas le script s'occupe de récupérer les bonnes extensions
            ' Renommage des noms
 
            VBAList = """" & Join(Application.Transpose(Application.Index(VA, 0, 1)), """, """) & """"
 
            MonScript = "set pFolder to " & Chr(34) & IIf(VApp > 15, Dossier, DossierAS) & Chr(34) & Chr(13) & "set myList to " & "{" & VBAList & "}"
            MonScript = MonScript & Chr(13) & "set TheNewlist to {}" & Chr(13) & "repeat with theItem in myList"
            MonScript = MonScript & Chr(13) & "set Chm to (do shell script ""find "" & quoted form of pFolder & "" -name "" & theItem & ""* | awk -F . '{print $2}'"") as text"
            MonScript = MonScript & Chr(13) & "set end of TheNewlist to Chm" & Chr(13) & "end repeat" & Chr(13) & "set text item delimiters to return" & Chr(13) & " set TheNewlist to TheNewlist as Unicode text"
            Ext = MacScript(MonScript): Ext = Split(Ext, vbNewLine)
 
            For i = LBound(VA) To UBound(VA)
                If InStr(VA(i, 1), ".") > 0 Then NomD = Mid(VA(i, 1), 1, InStr(VA(i, 1), ".") - 1) Else NomD = VA(i, 1)
                If Ext(i - 1) > "" Then
                    VB(i, 1) = VA(i, 2) & "_" & Format(NomD, "0000") & "." & Ext(i - 1)
                    Name Dossier & NomD & "." & Ext(i - 1) As Dossier & VB(i, 1)
                Else
                    VB(i, 1) = "Fichier non trouvé"
                End If
            Next
 
        Else
 
            '---------------------------------------------------------------------------------------------------------
            ' Partie de code lorsque le format du fichier est unique, dans ce cas la constante "Format" doit être renseignée - Ex : "xls" ou "jpg" …
            ' Renommage des noms
 
            On Error Resume Next ' =============== DEBUT GESTION D'ERREUR =================== => Obligatoire sur OS X pour la vérif avec Dir
                For i = LBound(VA) To UBound(VA)
                    If InStr(VA(i, 1), ".") > 0 Then NomD = Mid(VA(i, 1), 1, InStr(VA(i, 1), ".") - 1) Else NomD = VA(i, 1)
                    If Dir(Dossier & NomD & "." & FormatF) = vbNullString Then
                        VB(i, 1) = "Fichier non trouvé"
                    Else
                        VB(i, 1) = VA(i, 2) & "_" & Format(NomD, "0000") & "." & FormatF
                        Name Dossier & NomD & "." & FormatF As Dossier & VB(i, 1)
                    End If
                Next
            On Error GoTo 0 ' =============== FIN GESTION D'ERREUR ===================
 
        End If
 
    '---------------------------------------------------------------------------------------------------------
    ' Permet de mettre les nouveaux noms en remplacement ou en décalage de la colonne des anciens noms
    Cells(1 + Entete, Col_Nom + Decal_Col).Resize(UBound(VB)) = VB
 
    MsgBox "Renommage des fichiers terminé"
 
End Sub

le même sans les commentaires :

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
Sub RenommerFichiers()
Const FormatF = "" 'Format du fichier ex : "jpg" ou "pdf" … => si tout les fichiers à renommer ont le même format - sinon laisser à vide
Const Col_Nom = 2: Const Entete = 0: Const Decal_Col = 4
Dim VA, VB(), Dossier$, DossierAS$, DL&, i&, VBAList$, MonScript$, NomD$
    VApp = Val(Application.Version)
    #If Mac Then
        If VApp > 15 Then _
            Dossier = MacScript("tell application ""Finder"" to POSIX path of (choose folder) as Unicode text") Else _
            Dossier = MacScript("(choose folder) as Unicode text"): _
            DossierAS = MacScript("tell application ""Finder"" to POSIX path of " & Chr(34) & Dossier & Chr(34) & " as Unicode text")
    #Else
        MsgBox "Ce code est conçu pour Excel Mac 2011, 2016 et +": Exit Sub
    #End If
    DL = Cells(Rows.Count, Col_Nom).End(xlUp).Row
    VA = Range(Cells(1 + Entete, Col_Nom), Cells(DL, Col_Nom + 1)).Value
    ReDim VB(1 To UBound(VA), 1 To 1)
        If FormatF = "" Then
            VBAList = """" & Join(Application.Transpose(Application.Index(VA, 0, 1)), """, """) & """"
            MonScript = "set pFolder to " & Chr(34) & IIf(VApp > 15, Dossier, DossierAS) & Chr(34) & Chr(13) & "set myList to " & "{" & VBAList & "}"
            MonScript = MonScript & Chr(13) & "set TheNewlist to {}" & Chr(13) & "repeat with theItem in myList"
            MonScript = MonScript & Chr(13) & "set Chm to (do shell script ""find "" & quoted form of pFolder & "" -name "" & theItem & ""* | awk -F . '{print $2}'"") as text"
            MonScript = MonScript & Chr(13) & "set end of TheNewlist to Chm" & Chr(13) & "end repeat" & Chr(13) & "set text item delimiters to return" & Chr(13) & " set TheNewlist to TheNewlist as Unicode text"
            Ext = MacScript(MonScript): Ext = Split(Ext, vbNewLine)
            For i = LBound(VA) To UBound(VA)
                If InStr(VA(i, 1), ".") > 0 Then NomD = Mid(VA(i, 1), 1, InStr(VA(i, 1), ".") - 1) Else NomD = VA(i, 1)
                If Ext(i - 1) > "" Then
                    VB(i, 1) = VA(i, 2) & "_" & Format(NomD, "0000") & "." & Ext(i - 1)
                    Name Dossier & NomD & "." & Ext(i - 1) As Dossier & VB(i, 1)
                Else
                    VB(i, 1) = "Fichier non trouvé"
                End If
            Next
        Else  
            On Error Resume Next ' =============== DEBUT GESTION D'ERREUR =================== => Obligatoire sur OS X pour la vérif avec Dir
                For i = LBound(VA) To UBound(VA)
                    If InStr(VA(i, 1), ".") > 0 Then NomD = Mid(VA(i, 1), 1, InStr(VA(i, 1), ".") - 1) Else NomD = VA(i, 1)
                    If Dir(Dossier & NomD & "." & FormatF) = vbNullString Then
                        VB(i, 1) = "Fichier non trouvé"
                    Else
                        VB(i, 1) = VA(i, 2) & "_" & Format(NomD, "0000") & "." & FormatF
                        Name Dossier & NomD & "." & FormatF As Dossier & VB(i, 1)
                    End If
                Next
            On Error GoTo 0 ' =============== FIN GESTION D'ERREUR ===================
        End If
    Cells(1 + Entete, Col_Nom + Decal_Col).Resize(UBound(VB)) = VB
    MsgBox "Renommage des fichiers terminé"
End Sub

PS : Dans la vérification si on est sur Mac ou sur PC, on peut remplacer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 MsgBox "Ce code est conçu pour Excel Mac 2011, 2016 et +": Exit Sub

par un code de nommage de fichiers codé pour PC, comme l'appel d'une sub puis exit sub

Edit : si besoin d'infos supp, ne pas hésiter
Sinon j'attends le retour avec impatience pour savoir si tout est ok sur Excel 2016 et le cas échéant savoir ce qu'il y a à modifier

**hugoashka** · 03/04/2017, 19h38

bonjour, j'ai tester le code
et voici ce que cela affiche
Nom : capture.jpg
Affichages : 530
Taille : 1,04 Mo

**RyuAutodidacte** · 04/04/2017, 01h23

Bonsoir hugoashka,

Merci d'avoir testé, par contre j'ai besoin de savoir à quel endroit du code l'erreur s'est produite afin que je puisse corriger (utiliser le pas à pas si le code n'est pas surligné suite à l'erreur).

je voudrais aussi savoir si les noms des images sur le disque dur sont du type :
- 1.jpg, 15.jpg, etc …
ou
- 0001.jpg, 0015.jpg, etc …
??
si c'est du type 0001 alors pour tester mettre après ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

VA = Range(Cells(1 + Entete, Col_Nom), Cells(DL, Col_Nom + 1)).Value

celui-ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    For i = LBound(VA) To UBound(VA)
        VA(i, 1) = Format(VA(i, 1), "0000")
    Next

chez moi je les ai programmé dans ce format 1, 15 … ( et non 0001, 0015 …) - cela peut se modifier !

**hugoashka** · 09/04/2017, 14h46

apparemment l'erreur se trouverai sur cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  Dossier = MacScript("tell application ""Finder"" to POSIX path of (choose folder) as Unicode text") Else _

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
Sub RenommerFichiers()
Const FormatF = "" 'Format du fichier ex : "jpg" ou "pdf" … => si tout les fichiers à renommer ont le même format - sinon laisser à vide
Const Col_Nom = 2: Const Entete = 0: Const Decal_Col = 4
Dim VA, VB(), Dossier$, DossierAS$, DL&, i&, VBAList$, MonScript$, NomD$
    VApp = Val(Application.Version)
    #If Mac Then
        If VApp > 15 Then _
            Dossier = MacScript("tell application ""Finder"" to POSIX path of (choose folder) as Unicode text") Else _
            Dossier = MacScript("(choose folder) as Unicode text"): _
            DossierAS = MacScript("tell application ""Finder"" to POSIX path of " & Chr(34) & Dossier & Chr(34) & " as Unicode text")
    #Else
        MsgBox "Ce code est conçu pour Excel Mac 2011, 2016 et +": Exit Sub
    #End If
    DL = Cells(Rows.Count, Col_Nom).End(xlUp).Row
    VA = Range(Cells(1 + Entete, Col_Nom), Cells(DL, Col_Nom + 1)).Value
    ReDim VB(1 To UBound(VA), 1 To 1)
        If FormatF = "" Then
            VBAList = """" & Join(Application.Transpose(Application.Index(VA, 0, 1)), """, """) & """"
            MonScript = "set pFolder to " & Chr(34) & IIf(VApp > 15, Dossier, DossierAS) & Chr(34) & Chr(13) & "set myList to " & "{" & VBAList & "}"
            MonScript = MonScript & Chr(13) & "set TheNewlist to {}" & Chr(13) & "repeat with theItem in myList"
            MonScript = MonScript & Chr(13) & "set Chm to (do shell script ""find "" & quoted form of pFolder & "" -name "" & theItem & ""* | awk -F . '{print $2}'"") as text"
            MonScript = MonScript & Chr(13) & "set end of TheNewlist to Chm" & Chr(13) & "end repeat" & Chr(13) & "set text item delimiters to return" & Chr(13) & " set TheNewlist to TheNewlist as Unicode text"
            Ext = MacScript(MonScript): Ext = Split(Ext, vbNewLine)
            For i = LBound(VA) To UBound(VA)
                If InStr(VA(i, 1), ".") > 0 Then NomD = Mid(VA(i, 1), 1, InStr(VA(i, 1), ".") - 1) Else NomD = VA(i, 1)
                If Ext(i - 1) > "" Then
                    VB(i, 1) = VA(i, 2) & "_" & Format(NomD, "0000") & "." & Ext(i - 1)
                    Name Dossier & NomD & "." & Ext(i - 1) As Dossier & VB(i, 1)
                Else
                    VB(i, 1) = "Fichier non trouvé"
                End If
            Next
        Else
            On Error Resume Next ' =============== DEBUT GESTION D'ERREUR =================== => Obligatoire sur OS X pour la vérif avec Dir
                For i = LBound(VA) To UBound(VA)
                    If InStr(VA(i, 1), ".") > 0 Then NomD = Mid(VA(i, 1), 1, InStr(VA(i, 1), ".") - 1) Else NomD = VA(i, 1)
                    If Dir(Dossier & NomD & "." & FormatF) = vbNullString Then
                        VB(i, 1) = "Fichier non trouvé"
                    Else
                        VB(i, 1) = VA(i, 2) & "_" & Format(NomD, "0000") & "." & FormatF
                        Name Dossier & NomD & "." & FormatF As Dossier & VB(i, 1)
                    End If
                Next
            On Error GoTo 0 ' =============== FIN GESTION D'ERREUR ===================
        End If
    Cells(1 + Entete, Col_Nom + Decal_Col).Resize(UBound(VB)) = VB
    MsgBox "Renommage des fichiers terminé"
End Sub

**RyuAutodidacte** · 10/04/2017, 21h59

Bonsoir hugoashka,

A tous ceux qui passent par là et qui sont sur Mac
Pour que ça soit plus simple, j'ai installé la version d'essai d'Excel 2016, et bien ça été la grande surprise (et pas dans le meilleurs sens du terme) pour la partie vba
• La fenêtre d'exécution a été amoindri grandement, on ne peut plus compléter le code automatiquement par raccourcis clavier, ni faire des retours ligne
• on ne peut plus compléter le code automatiquement par raccourcis clavier dans un simple module …
• mais où est passé la fenêtre des variables locales ??? ben y en a plus => bonjour le débogguage
et je dois en oublier car je n'ai pas encore tout vu; j'ai quand même voulu prendre qq renseignement sur le sujet :
https://answers.microsoft.com/fr-fr/...2-ec0db5e01d94
=> Tout ça pour dire que la partie vba sur Mac pour Excel 2016 a été amoindri jusqu'à son stricte minimum => grosso modo, mettre du code dans une fenêtre

=> Donc pour les amis codeurs qui veulent faire du VBA rester sur Excel 2011

Du coup j'ai du faire à coup de Debug.Print et petit rajout de code pour débogguer,
pas de grosse corrections, et pour la partie Macscript des nuances sensées marcher entre Excel 2011 et 2016 (comme l'appel du Finder), mais qui font planter sur Excel 2016

hugoashka : j'ai rajouté de petits commentaires, donc à relire, dis moi si tout est ok …

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
Sub RenommerFichiers()
Const FormatF = "" 'Format du fichier ex : "jpg" ou "pdf" … => si tout les fichiers à renommer ont le même format - sinon laisser à vide
Const Col_Nom = 2: Const Entete = 0: Const Decal_Col = 4
Dim VA, VB(), Dossier$, DossierAS$, DL&, i&, VBAList$, MonScript$, NomD$, Ext
    '---------------------------------------------------------------------------------------------------------
    ' Détection si le code est utilisé sur un Mac puis détecte la version d'Excel (pour Excel 2011 - 2016)
    VApp = Val(Application.Version)
    #If Mac Then
        If VApp >= 15 Then _
            Dossier = MacScript("POSIX path of (choose folder) as Unicode text") Else _
            Dossier = MacScript("(choose folder) as Unicode text"): _
            DossierAS = MacScript("tell application ""Finder"" to POSIX path of " & Chr(34) & Dossier & Chr(34) & " as Unicode text")
    #Else
        MsgBox "Ce code est conçu pour Excel Mac 2011, 2016 et +": Exit Sub
    #End If
 
    DL = Cells(Rows.Count, Col_Nom).End(xlUp).Row
    VA = Range(Cells(1 + Entete, Col_Nom), Cells(DL, Col_Nom + 1)).Value
    'For i = LBound(VA) To UBound(VA) ' Boucle à utiliser si le nom du fichier dans les disque dur est du type "0000" (comme "0015") alors que dans Excel le nom est du type "0" (comme "15")
    '    VA(i, 1) = Format(VA(i, 1), "0000")
    'Next
 
    ReDim VB(1 To UBound(VA), 1 To 1)
 
        If FormatF = "" Then
 
            '---------------------------------------------------------------------------------------------------------
            ' Partie de code lorsque le format du fichier n'est pas connu à l'avance , dans ce cas le script s'occupe de récupérer les bonnes extensions
            ' Attention toutefois dans cette version, si il y a plusieurs noms identiques mais avec des extensions différentes, le code prendra la 1ère extension trouvé
            ' Renommage des noms
 
            VBAList = """" & Join(Application.Transpose(Application.Index(VA, 0, 1)), """, """) & """"
 
            MonScript = "set pFolder to " & Chr(34) & IIf(VApp > 15, Dossier, DossierAS) & Chr(34) & Chr(13) & "set myList to " & "{" & VBAList & "}"
            MonScript = MonScript & Chr(13) & "set TheNewlist to {}" & Chr(13) & "repeat with theItem in myList"
            MonScript = MonScript & Chr(13) & "set Chm to (do shell script ""find "" & quoted form of pFolder & "" -name "" & theItem & ""* | awk -F . '{print $2}'"") as text"
            MonScript = MonScript & Chr(13) & "set end of TheNewlist to Chm" & Chr(13) & "end repeat" & Chr(13) & "set text item delimiters to return" & Chr(13) & " set TheNewlist to TheNewlist as Unicode text"
            Ext = MacScript(MonScript): Ext = Split(Ext, Chr(13))
    For i = LBound(Ext) To UBound(Ext): Debug.Print Ext(i): Next
 
            For i = LBound(VA) To UBound(VA)
                If InStr(VA(i, 1), ".") > 0 Then NomD = Mid(VA(i, 1), 1, InStr(VA(i, 1), ".") - 1) Else NomD = VA(i, 1)
                If Ext(i - 1) > "" Then
                    VB(i, 1) = VA(i, 2) & "_" & Format(NomD, "0000") & "." & Ext(i - 1)
                    Name Dossier & NomD & "." & Ext(i - 1) As Dossier & VB(i, 1)
                Else
                    VB(i, 1) = "Fichier non trouvé"
                End If
            Next
 
        Else
 
            '---------------------------------------------------------------------------------------------------------
            ' Partie de code lorsque le format du fichier est unique, dans ce cas la constante "Format" doit être renseignée - Ex : "xls" ou "jpg" …
            ' Renommage des noms
 
            On Error Resume Next ' =============== DEBUT GESTION D'ERREUR =================== => Obligatoire sur OS X pour la vérif avec Dir
                For i = LBound(VA) To UBound(VA)
                    If InStr(VA(i, 1), ".") > 0 Then NomD = Mid(VA(i, 1), 1, InStr(VA(i, 1), ".") - 1) Else NomD = VA(i, 1)
                    If Dir(Dossier & NomD & "." & FormatF) = vbNullString Then
                        VB(i, 1) = "Fichier non trouvé"
                    Else
                        VB(i, 1) = VA(i, 2) & "_" & Format(NomD, "0000") & "." & FormatF
                        Name Dossier & NomD & "." & FormatF As Dossier & VB(i, 1)
                    End If
                Next
            On Error GoTo 0 ' =============== FIN GESTION D'ERREUR ===================
 
        End If
 
    '---------------------------------------------------------------------------------------------------------
    ' Permet de mettre les nouveaux noms en remplacement ou en décalage de la colonne des anciens noms
    Cells(1 + Entete, Col_Nom + Decal_Col).Resize(UBound(VB)) = VB
 
    MsgBox "Renommage des fichiers terminé"
 
End Sub

**hugoashka** · 13/04/2017, 22h20

jai tester le code, je choisi le bon dossier a l'ouverture de la fenêtre la boite de dialogue apparait en me disant que les fichier on bien été renommé mais en collonne F cela manque "fichier non trouver"
et en effect il ne sont pas renommé.

merci pour ton investissement

**RyuAutodidacte** · 13/04/2017, 23h02

Bonsoir,

Y a pas de quoi, n'hésite pas à revenir vers moi, au cas où tu vois un fonctionnement anormal ou quelque chose auquel je n'aurai pas pensé ou omis

Si tout est ok pour toi n'oublie pas de passer la discussion en résolu.

Ryu

**hugoashka** · 14/04/2017, 19h38

en faite il y a juste un petit problème que je ne comprend pas tous ce passe comme prévu mais les fichiers ne sont au final pas renommé :/

**RyuAutodidacte** · 14/04/2017, 23h44

Bonsoir,

oui c'est bizarre car lors de mes test je n'ai pas rencontré le souci.

Pour info mes test on été effectué avec :
- OS X El Capitan version 10.11.6
- Excel 2016 version 15.32

Edit :
En effet j'avais omis un paramètre, j'espère que cette fois ci tout est bon.
j'ai fait les modifications nécessaires et ajouté un MsgBox permettant de valider si les noms sur le disque dur sont du type "0001" ou "1"

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
82
83
84
85
Sub RenommerFichiers()
Const FormatF = "" 'Format du fichier ex : "jpg" ou "pdf" … => si tout les fichiers à renommer ont le même format - sinon laisser à vide
Const Col_Nom = 2: Const Entete = 0: Const Decal_Col = 4
Dim VA, VB(), Dossier$, DossierAS$, DL&, i&, VBAList$, MonScript$, NomD$, Ext
    '---------------------------------------------------------------------------------------------------------
    ' Détection si le code est utilisé sur un Mac puis détecte la version d'Excel (pour Excel 2011 - 2016)
    VApp = Val(Application.Version)
    #If Mac Then
        If VApp >= 15 Then _
            Dossier = MacScript("POSIX path of (choose folder) as Unicode text") Else _
            Dossier = MacScript("(choose folder) as Unicode text"): _
            DossierAS = MacScript("tell application ""Finder"" to POSIX path of " & Chr(34) & Dossier & Chr(34) & " as Unicode text")
    #Else
        MsgBox "Ce code est conçu pour Excel Mac 2011, 2016 et +": Exit Sub
    #End If
 
    DL = Cells(Rows.Count, Col_Nom).End(xlUp).Row
    VA = Range(Cells(1 + Entete, Col_Nom), Cells(DL, Col_Nom + 1)).Value
 
    NomType = MsgBox("Les noms des photos sont-ils du type ""0001"" ?", vbYesNo, "Noms type des photos sur le disque dur")
    If NomType = vbYes Then
        For i = LBound(VA) To UBound(VA) ' Boucle à utiliser si le nom du fichier dans les disque dur est du type "0000" (comme "0015") alors que dans Excel le nom est du type "0" (comme "15")
            If InStr(VA(i, 1), ".") > 0 Then
                VA(i, 1) = Format(Left(VA(i, 1), InStr(VA(i, 1), ".") - 1), "0000")
            Else
                VA(i, 1) = Format(VA(i, 1), "0000")
            End If
        Next
    End If
 
    ReDim VB(1 To UBound(VA), 1 To 1)
 
        If FormatF = "" Then
 
            '---------------------------------------------------------------------------------------------------------
            ' Partie de code lorsque le format du fichier n'est pas connu à l'avance , dans ce cas le script s'occupe de récupérer les bonnes extensions
            ' Attention toutefois dans cette version, si il y a plusieurs noms identiques mais avec des extensions différentes, le code prendra la 1ère extension trouvé
            ' Renommage des noms
 
            VBAList = """" & Join(Application.Transpose(Application.Index(VA, 0, 1)), """, """) & """"
 
            MonScript = "set pFolder to " & Chr(34) & IIf(VApp > 15, Dossier, DossierAS) & Chr(34) & Chr(13) & "set myList to " & "{" & VBAList & "}"
            MonScript = MonScript & Chr(13) & "set TheNewlist to {}" & Chr(13) & "repeat with theItem in myList"
            MonScript = MonScript & Chr(13) & "set Chm to (do shell script ""find "" & quoted form of pFolder & "" -name "" & theItem & ""* | awk -F . '{print $2}'"") as text"
            MonScript = MonScript & Chr(13) & "set end of TheNewlist to Chm" & Chr(13) & "end repeat" & Chr(13) & "set text item delimiters to return" & Chr(13) & " set TheNewlist to TheNewlist as Unicode text"
            Ext = MacScript(MonScript): Ext = Split(Ext, Chr(13))
    For i = LBound(Ext) To UBound(Ext): Debug.Print Ext(i): Next
 
            For i = LBound(VA) To UBound(VA)
                If InStr(VA(i, 1), ".") > 0 Then NomD = Mid(VA(i, 1), 1, InStr(VA(i, 1), ".") - 1) Else NomD = VA(i, 1)
                If Ext(i - 1) > "" Then
                    VB(i, 1) = VA(i, 2) & "_" & Format(NomD, "0000") & "." & Ext(i - 1)
                    Name Dossier & NomD & "." & Ext(i - 1) As Dossier & VB(i, 1)
                Else
                    VB(i, 1) = "Fichier non trouvé"
                End If
            Next
 
        Else
 
            '---------------------------------------------------------------------------------------------------------
            ' Partie de code lorsque le format du fichier est unique, dans ce cas la constante "Format" doit être renseignée - Ex : "xls" ou "jpg" …
            ' Renommage des noms
 
            On Error Resume Next ' =============== DEBUT GESTION D'ERREUR =================== => Obligatoire sur OS X pour la vérif avec Dir
                For i = LBound(VA) To UBound(VA)
                    If InStr(VA(i, 1), ".") > 0 Then NomD = Mid(VA(i, 1), 1, InStr(VA(i, 1), ".") - 1) Else NomD = VA(i, 1)
                    If Dir(Dossier & NomD & "." & FormatF) = vbNullString Then
                        VB(i, 1) = "Fichier non trouvé"
                    Else
                        VB(i, 1) = VA(i, 2) & "_" & Format(NomD, "0000") & "." & FormatF
                        Name Dossier & NomD & "." & FormatF As Dossier & VB(i, 1)
                    End If
                Next
            On Error GoTo 0 ' =============== FIN GESTION D'ERREUR ===================
 
        End If
 
    '---------------------------------------------------------------------------------------------------------
    ' Permet de mettre les nouveaux noms en remplacement ou en décalage de la colonne des anciens noms
    Cells(1 + Entete, Col_Nom + Decal_Col).Resize(UBound(VB)) = VB
 
    MsgBox "Renommage des fichiers terminé"
 
End Sub

Ryu

Edit 2 :
A force de chercher, j'ai trouvé 2 liens expliquant des points important concernant Excel Mac 2016 en ce qui concerne notamment AppleScript :
https://dev.office.com/blogs/VBA-imp...in-Office-2016
https://msdn.microsoft.com/fr-fr/lib.../mt654021.aspx
Donc d'après ce que j'ai pu tester sur Excel Mac 2016, certains code avec MacScript peuvent encore passer, mais dorénavant il faudra passer par AppleScriptTask,
que j" n'ai pas encore vu … à suivre …
Je pense qu'un point sur le sujet dans la Faq serait bien …

**parmi** · 19/04/2017, 17h17

Je viens de lire un article... quelque chose que je ne savais pas...

Sous Win 7 (et probablement plus récents), on peut sélectionner plusieurs fichiers, click droit puis Renommer.
En changeant le nom d'un seul fichier plus ENTER, tous les fichiers prennent le même nom avec un numéro ajouté...
C'est donc assez rapide à moins d'avoir beaucoup de manipulations à faire...

Par contre, je ne sais pas si ça peut se faire sous Mac (?)

**hugoashka** · 19/04/2017, 17h35

Oui cela ce fait sous mac mais quand il y a un total de plus de 400photos cela devien long 😀😀
En revanche j'ai resseyee le nouveau code mais cela ne change rien toujour le même problème :/

**RyuAutodidacte** · 19/04/2017, 17h52

Bonjour,
Quel le problème exactement ?
Car je l'ai essayé plusieurs fois de différentes manières et je n'ai eu aucun souci.
Peux tu me d'écrire la ou ça coince ? Ou peut être est-ce une mauvaise utilisation et dans ce cas là je re-explique …

**RyuAutodidacte** · 20/04/2017, 09h31

Bonjour,
J'ai re-testé le code hier et je n'ai eu aucun souci de renommage des fichiers.
Il faudrait m'expliquer les conditions de ton test sur la feuille Excel et dans le dossier où se trouve les photos
Forcément si de photos ont déjà été renommée, il ne les trouvera pas étant donné que les noms de départ son supposé être (du type) en "1" ou "0001" dans la feuille Excel et dans le dossier

script pour renommer fichier

Macros et VBA Excel

Discussions similaires

Partager

Partager