[VB.NET -> VBA]Renomer fichiers (comme W7) en VBA [Résolu]

- - Dernière réponse :  Scarbiet94 - 16 mai 2013 à 18:13
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.

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]
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
[code]
Afficher la suite 

20/23 réponses

Meilleure réponse
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
212
3
Merci
Bonjour,
Question très importante :
Es-tu bien certain de développer sous
Forum >
VB.NET et VB 2005

Le code que tu montres laisserait plutôt penser à du VB6 ou à du VBA !


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 188 internautes nous ont dit merci ce mois-ci

Commenter la réponse de ucfoutu
3
Merci
Bonjour ucfoutu,

Le code que tu montres laisserait plutôt penser à du VB6 ou à du VBA !


Eh oui ! C'est ce que le titre, et la question, disent.

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 188 internautes nous ont dit merci ce mois-ci

Commenter la réponse de Utilisateur anonyme
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61
3
Merci
Salut

Catégorie modifiée (à mémoriser pour la prochaine fois)

Pour info, Error 5 = Argument ou appel de procédure incorrect
(c'est surtout le message qui est important - n'oblige pas les lecteurs à faire une recherche)

Vérifie que dans ton projet tu n'as pas appelé une procédure (Sub ou Function) du nom de DIR.

Comment fais-tu la fonction Fichier_Existe ?
Attention à ne pas réutiliser la fonction DIR dans cette procédure, elle s'en trouverait réinitialisée.
Voir cette <source> (et les explications complètes) utilisable sous VBA.

PS : Cette ligne ne sert à rien :
Pos = Len(Fichier) - (Len(Ext) + LenEntier + 2)

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on le partage (Socrate)

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 188 internautes nous ont dit merci ce mois-ci

Commenter la réponse de cs_Jack
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
212
3
Merci
Bonjour, jack,
Catégorie modifiée (à mémoriser pour la prochaine fois)

J'ai comme l'impression que le déplacement ne s'est pas effectué.

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 188 internautes nous ont dit merci ce mois-ci

Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
212
3
Merci
Et je e vois nulle part, dans ton code, ce qui pourrait correspondre au "relevé" d'une dimension de fichier
qui lit les dimensions de fichiers image pour les placer en début de nom

Que sont pour toi les dimensions d'un fichier image ?
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 188 internautes nous ont dit merci ce mois-ci

Commenter la réponse de ucfoutu
Messages postés
14570
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
21 octobre 2019
136
3
Merci
Bonjour,

Corrigé, message déplacé :)

v----Signature--------v----------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS, celui-ci pour bien poser votre question ou encore celui-ci pour les PFE et autres exercices.[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : ).[*]En VB.NET pensez à activer Option Explicit et Option Strict (propriété du projet) et à retirer l'import automatique de l'espace de nom Microsoft.VisualBasic (onglet Références dans les propriétés du projet).[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés/list
---
Mon site

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 188 internautes nous ont dit merci ce mois-ci

Commenter la réponse de NHenry
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61
3
Merci
Zavais oublié, lol
Merci pour ces rappels

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 188 internautes nous ont dit merci ce mois-ci

Commenter la réponse de cs_Jack
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
212
0
Merci
Et on peut se demander à quoi servirait une expression conditionnelle sur caspartriculier (si true) alors qu'on a mis sa valeur à True !


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Commenter la réponse de ucfoutu
0
Merci
Merci à tous pour ces réponses (pour un premier mai) auxquelles je vais essayer d'apporter des éclaircissements.

Je me suis mis dans cette catégorie, car je n'ai pas trouvé celle qui correspond au VBA. Forum\Visual Basic\Langages dérivés\ (si ce n'est ça, merci de me l'indiquer)

Ci-après les fonctions appelées par la procédure

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



Comme je l'ai dit, je débute en VBA
La valeur booléenne CasPartriculier, me sert à différencier les fichiers type nom(1).jpg, nom(2).jpg tec de ceux qui se termineraient par un nombre non entier entre parenthèses nom(1.1).jpg ou nom(a).jpg

La ligne
Pos = Len(Fichier) - (Len(Ext) + LenEntier + 2)
est faite pour calculer la longueur du nom à conserver : longueur totale - l'extension - moins la place prise par l'expression (1) ou (10) située en fin de nom


Je voulais obtenir les dimensions en pixels de fichiers images. Je suis tombé sur un objet
stdole.StdPicture
qui donne les dimensions dans une unité que je ne connais pas. J'ai trouvé un ratio qui me donne les valeurs en pixels, convertis en texte :

Sub TailleImage()
Const Ratio = 26.458005
Dim oPict As New stdole.StdPicture
Dim Tmp, FichDeb, SH, SL  As String
Dim H As Single
Dim L As Single
    Tmp = Repertoire & Fichier
    On Error Resume Next
    Set oPict = stdole.LoadPicture(Tmp)
    H = oPict.Height / Ratio
    L = oPict.Width / Ratio
    SH = Str(CLng(H))
    SL = Str(CLng(L))
End Sub


Voilà, j'espère avoir répondu à toutes les questions, je vais regarder le liens de Jack. Merci encore pour les réponses, je continue à apprendre
Commenter la réponse de Scarbiet94
0
Merci
J'ai 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 :

Dim St, Fichier As String

au lieu de 
Dim St As String
Dim Fichier As String



J'ai 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 :
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)
Commenter la réponse de Scarbiet94
0
Merci
Bonjour,

J'ai 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 :

Dim St, Fichier As String


Rien d'inquiétant là-dedans. Avec ta ligne écrite comme cela; seul fichier est considéré comme étant de type String. St est en variant. C'est différent en VB.net.
Commenter la réponse de Utilisateur anonyme
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61
0
Merci
Ok pour ces précisions.
Donc, comme je le pensais, tu utilises DIR alors que tu as déjà une boucle qui s'en sert.
Voir le lien que je t'ai fourni pour les explications.
Commenter la réponse de cs_Jack
0
Merci
Je vérifié cela demain ou ce week-end
Commenter la réponse de Scarbiet94
0
Merci
Bonjour,

Après avoir potassé le VBA, j'arrive à cette procédure qui semble fonctionner.
Sub FichierRenome(OldFich As String, NewFich As String)
Dim FichierInit, St, Ajout As String
Dim FSO As Object
Dim i As Byte

Set FSO = CreateObject("Scripting.FileSystemObject")
St = NewFich
On Error Resume Next
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


Quelqu'un m'a envoyé cette fonction qui remplace avantageusement la mienne
Function ExtFich(Fichier As String) As String
    P InStrRev(Fichier, "."):  If P Then ExtFich Mid(Fichier, P)
End Function
Commenter la réponse de Scarbiet94
0
Merci
La procédure ci-dessus fonctionne correctement excepté dans un cas, lorsque les fichiers sont tous les mêmes : chiffre avec un compteur à la fin du nom. Exemple (1).jpg, (2).jpg, (3).jpg, (4).jpg....

Dans ce cas, après avoir renommé tous les fichiers du répertoire, la procédure appelante ci-dessous repart et renomme tout ou partie avec le compteur (1) et les bons noms de fichiers.

Procédure appelante :
Sub ChercherFichiers()
Dim FSO As Object
Dim DossierSource As Object
Dim Fichier As Object
Dim NomFich As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set DossierSource = FSO.GetFolder(Repertoire)

    For Each Fichier In DossierSource.Files
        NomFich = Fichier.Name
        TraiteFichier (NomFich)
        i = i + 1
    Next Fichier
    
    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub


Si quelqu'un peut m'aider je l'en remercie.
Commenter la réponse de Scarbiet94
0
Merci
Bonjour,

Mets un point d'arrêt (F9) sur la ligne suivante:

Set FSO = Nothing


Et relance ta macro dans les conditions problématiques. Quand la macro va s'arrêter au point d'arrêt; continue au pas à pas (F8). En principe, tu devrais voir si la macro sort vraiment de là. Tu peux aussi utiliser les espions pour suivre les noms de fichiers.

Au besoin "monte" ton point d'arrêt au début de ta procédure et vérifie ce qui se passe avec les noms de fichiers.
Commenter la réponse de Utilisateur anonyme
0
Merci
Bonsoir,

J'ai refais à nouveau du "pas à pas (F8) + espions". Le premier fichier renommé est celui qui se termine par (1).jpg le dernier par (9).jpg, ce qui semble logique. Par contre ce qui l'est moins, c'est ça fonctionne jusqu'à 40 fichiers. Au-delà ça reboucle tout ou partie, à partir de
For Each Fichier In DossierSource.Files

Je ne comprends pas. Si tu as une idée.... la valeur 40 n'apparaît nulle part.
Commenter la réponse de Scarbiet94
0
Merci
Bonjour,

Par contre ce qui l'est moins, c'est ça fonctionne jusqu'à 40 fichiers. Au-delà ça reboucle tout ou partie, à partir de


Quand tu mets ton point d'arrêt sur :

Set FSO = Nothing


et que tu continues au pas-à-pas est-ce que :

1) Tu quittes vraiment cette sub là ?
2) Si tu quittes la sub, qu'est ce qui fait que tu y retournes ?

Parce que si tu quittes vraiment la sub et qu'elle n'est pas rappelée, le problème est probablement ailleurs.

Si tu ne quittes pas la sub je pense que tu devrais essayer de reprendre la sub TraiteFichier () sans aucune instruction On error et/ou même la reprendre au pas à pas et avec des espions
Commenter la réponse de Utilisateur anonyme
0
Merci
Bonjour,

Je vais suivre tes conseils. En effet, si je fais lister les fichiers dans une feuille Excel sans passer par la fonction renommer ou Tailleimage, il n'y a aucun problème.

Merci pour ton aide
Commenter la réponse de Scarbiet94
0
Merci
Bonjour cmarcotte,

J'ai fais toute une série de test. La macro ne fonctionne pas uniquement si les fichiers sont de type (1).jpg, (2).jpg.... (n).jpg. Je n'ai trouvé aucune anomalie dans les procédures FichierRenome et TailleImage et TraiteFichier. Uniquement pour cette numérotation de fichier, la boucle
For Each Fichier In DossierSource.Files
    NomFich = Fichier.Name
    TraiteFichier (NomFich)
Next Fichier

ne s'arrête pas au nombre de fichiers du dossier, mais en traite entre 15 % et 30 % de plus. Je vais éviter de renommer ce type de fichiers, le reste fonctionne. J'aurais bien aimé connaître la raison de cette exception.

A+
Commenter la réponse de Scarbiet94