Discussion :

[94Skarb]

Bonjour à tous,

Avant de m'attaquer à une macro qui ne me semble pas simple, je parcours les forums pour apprendre le VBA. Pour finir une macro "d'essai" qui lit les dimensions de fichiers image pour les placer en début de nom, je n'arrive pas à terminer la partie qui consiste à renommer un fichier existant comme le fait Window 7 : nom(1).jpg, nom(2) .jpg, nom(3). .jpg...
J'ai une erreur d’exécution 5 qui se produit à la ligne St = Dir.

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
 
Sub Teste_Si_Fichier_Existe_Et_Renome()
Dim NouveauNom, Ext, Su, Ajout As String
Dim Repertoire As String
Dim Fso As Object
Dim Pos, Nbre, Pos1, Pos2, LenEntier As Integer
Dim CasParticulier As Boolean
Dim St As String
Dim Fichier As String
 
'Choix du répertoire
Repertoire = ChoixRepertoire & "\"
 
'première entrée fichier
Fichier = Dir(Repertoire, vbNormal Or vbHidden)
 
' recherche l'extension pour les fichiers qui contiennent
' un ou plusieurs points dans leur nom : 1.5.jpg, nom.suit.1.xls
Ext = Extension(Fichier)
 
Set Fso = CreateObject("Scripting.FileSystemObject")
St = Repertoire & Fichier
 
Ajout = "(1)" 'renomme avec (1)° par défaut
CasParticulier = True
 
While Dir(St) <> ""
    While Fichier_Existe(St)
        'Recherche le fichiers se terminant par (n)
        Pos = InStr(Fichier, ").")
        If Pos <> 0 And CasParticulier Then
            Pos2 = InStr(Fichier, "(")
            LenEntier = Pos - Pos2 - 1
            Su = Mid(Fichier, Pos2 + 1, LenEntier)
            If IsNumeric(Su) And Pos2 >= 2 Then
                Nbre = CInt(Su)
                Nbre = Nbre + 1
                Ajout = "(" & Trim(Str(Nbre)) & ")"
                Pos = Len(Fichier) - (Len(Ext) + LenEntier + 2)
                NouveauNom = Left(Fichier, Pos) & Ajout & Ext
            Else
                'le nom du fichier se termine par une parenthèse
                ' non précédée par un nombre entier
                NouveauNom = Left(Fichier, InStr(Fichier, Ext) - 1) & Ajout & Ext
                CasParticulier = False
            End If
        Else
            NouveauNom = Left(Fichier, InStr(Fichier, Ext) - 1) & Ajout & Ext
        End If
        NouveauNom = Trim(NouveauNom)
        Fso.MoveFile Fichier, NouveauNom
    Wend
St = Dir
Wend
 
End Sub

Merci par avance, je sèche.
Question très subsidiaire. Je m’aperçois que la recherche de la parenthèse ouverte ne permet pas d'obtenir 1(a).jpg puis 1(a)(1).jpg

PS Je me suis basé sur la procédure suivante qui fonctionne

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
 
Sub Liste_Fichiers_jpg()
 Dim Filtre As String, Fichiers As String, Nomm As String
 On Error Resume Next
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choisir un dossier..........."
        .Show
        If .SelectedItems.Count > 0 Then
           NomDossier = .SelectedItems(1) & "\"
        End If
    End With
    Filtre = "*.jpg"
    Fichiers = Dir(NomDossier & "\" & Filtre, vbNormal Or vbHidden)
 
    While Fichiers <> ""
        Nomm = Left(Fichiers, Len(Fichiers) - 4)
        Fichiers = Dir
    Wend
End Sub

[Daniel.C]

Bonjour,

Il est possible que l'erreur se produise quand tu cherches à ouvrir un dossier système.

[94Skarb]

Bonjour,

Le dossier test que j'utilise est un dossier normal. Si cela peut aider je joints les fonctions appelées par la procédure.

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
 
Function ChoixRepertoire() As String
Dim Repert As FileDialog
Set Repert = Application.FileDialog(msoFileDialogFolderPicker)
Repert.Title = "Choisir le dossier de travail"
Repert.Show
If Repert.SelectedItems.Count > 0 Then
    ChoixRepertoire = Repert.SelectedItems(1)
Else
    ' Touche annule ou Excape. Fin macro"
    End
End If
End Function
 
Function Fichier_Existe(Path As String) As Boolean
If Dir(Path) = "" Then
    Fichier_Existe = False
Else
    Fichier_Existe = True
End If
End Function
 
 
Function Extension(Nomfich As String) As String
Dim Ch, S, Ext As String
Dim i As Integer
Ext = ""
Extension = ""
i = 1
S = StrReverse(Nomfich)
Ch = Mid(S, 1, 1)
While Ch <> "."
    Ext = Ext + Ch
    i = i + 1
    Ch = Mid(S, i, 1)
Wend
Extension = "." & StrReverse(Ext)
End Function

J'ai également oublié de dire que je ne peux pas démarrer la macro si la définition des variables St et Fichier se fait sur la même ligne :

Code :

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

1
2
3
4
5
 
Dim St, Fichier As String
au lieu de 
Dim St As String
Dim Fichier As String

J'ai également oublié de dire que je ne peux pas démarrer la macro si la définition des variables St et Fichier se fait sur la même ligne :

Code :

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

1
2
3
4
5
6
 
Dim St, Fichier As String
 
au lieu de 
Dim St As String
Dim Fichier As String

Ca génère une erreur sur St dans la ligne While Fichier_Existe(St)

Cordialement
Cordialement

[SfJ5Rpw8]

Quel est le message d'erreur ?

Quelle est l'utilité de l'appel de ta fonction Fichier_Existe ..? qui ne fait rien de plus que le

Code :

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

While Dir(St) <> ""

sur la ligne précédente ?

[NVCfrm]

bonjour,

erreur 5:
appel de procédure incorrecte.

place un point d'arrêt avec la touche F9 à la ligne : MoveFile
observe les valeurs de tes variables. pas à pas avec F8

[94Skarb]

Bonjour et merci pour vos réponses

Je n'avais pas trouvé d'erreur en suivant le code en faisant F8. En lisant la remarque de bbil, je pense avoir fait une erreur de débutant.

En effet dans la macro complète, la procédure débute à

Code :

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

While Fichier_Existe(St)

la recherche de fichier est faite dans une procédure qui affecte un nouveau nom puis l'enregistre, après un test incomplet d'existence éventuelle, d'un autre fichier portant le nouveau nom.

Dans le cas présent

Code :

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

 While Fichier_Existe(St)

vient en doublon de

Code :

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

While Dir(St) <> ""

Elle génère très probablement le message d'erreur. En pistant avec F8, le deuxième while (remplacé par un if) lit à nouveau la première entrée (la seconde correspond au fichier renommé).

Je vais repartir sur des bases plus saines.

Pour bbil : j'avais lu le règlement du forum. J'espère l'avoir respecté.

Cordialement,

[94Skarb]

Bonjour,

Après avoir potassé le VBA, j'arrive à cette procédure qui semble fonctionner.

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
 
Sub FichierRenome(OldFich As String, NewFich As String)
Dim FichierInit As String
Dim Ajout As String
Dim FSO As Object
Dim i As Byte
Dim St As String
 
Set FSO = CreateObject("Scripting.FileSystemObject")
St = NewFich
FichierInit = NewFich
i = 1
 
While Fichier_Existe(St)
    Ajout = "(" & Trim(Str(i)) & ")"
    NewFich = NomFichSeul(FichierInit) & Ajout & Ext
    i = i + 1
    St = NewFich
Wend
 
NewFich = Trim(NewFich)
FSO.MoveFile OldFich, NewFich
End Sub

Merci à Marc-L pour la fonction "extraire l'extension"

Code :

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

1
2
3
4
 
Function ExtFich(Fichier As String) As String
    P = InStrRev(Fichier, "."):  If P Then ExtFich = Mid(Fichier, P)
End Function

[94Skarb]

Bonjour,

La maco fonctionne, excepté lorsque les fichiers sont de type (1).jpg, (2).jpg.... (n).jpg. Dans ce cas (uniquement), la boucle :

Code :

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

1
2
3
4
5
 
For Each Fichier In DossierSource.Files
    NomFich = Fichier.Name
    'traitement du fichier
Next Fichier

ne s'arrête pas quand le nombre de fichier d'un dossier mais en traite entre 15 % et 30 % de plus. J'ai fais toute une série de tests sur les différentes procédure, l'erreur se produit au même endroit.

Pour que çà fonctionne je détermine le nombre de fichiers dans le répertoire. Quant le nombre est atteint, je fais un Goto fin de procédure pour sortir de la boucle For Each Fichier. Ca marche, mais ce n'est pas satisfaisant. Si quelqu'un a une idée... j'aimerai comprendre.

(La seule modification apportée à la procédure FichierRenome est de remplacer

Code :

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

While Fichier_Existe(St)

par

Code :

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

While FSO.FileExists(St)

ce qui ne change rien).