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

Question

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]

ucfoutu · Accepted Answer

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.

Utilisateur anonyme · Answer

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.

cs_Jack · Answer

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)

ucfoutu · Answer

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.

ucfoutu · Answer

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.

ucfoutu · Answer

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.

NHenry · Answer

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

cs_Jack · Answer

Zavais oublié, lol
Merci pour ces rappels

Scarbiet94 · Answer

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

Scarbiet94 · Answer

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)

Utilisateur anonyme · Answer

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.

cs_Jack · Answer

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.

Scarbiet94 · Answer

Je vérifié cela demain ou ce week-end

Scarbiet94 · Answer

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

Scarbiet94 · Answer

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.

Utilisateur anonyme · Answer

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.

Scarbiet94 · Answer

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.

Utilisateur anonyme · Answer

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

Scarbiet94 · Answer

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

Scarbiet94 · Answer

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+

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

23 réponses

Votre réponse

Discussions similaires