Résolu XL 2016 Selectionner une photo par un lien et la sauvegarder dans un dossier en changeant son nom

francis Hollard

XLDnaute Nouveau
Bonjour,

J'ai un fichier avec des photos et leurs lien d'un côté, j'ai un nom pré-défini dans une cellule et le lien du dossier de destination.
J'aimerai sélectionner la photo via ce lien, la renommer avec le nom pré-défini et la sauvegarder dans le dossier de destination.
Je suis novice en VBA, quelqu'un pourrai me donner un coup de main?

Merci beaucoup.
 
Ce fil a été résolu! Aller à la solution…

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour francis Hollard, bienvenue sur XLD,

Il s'agit de copier le fichier image vers un autre dossier, exécutez cette macro :
VB:
Sub CopierFichier()
Dim fichier, nom, dossier, extension$
fichier = Application.InputBox("Sélectionnez la cellule :", "Adresse de la photo")
If fichier = False Then Exit Sub
nom = Application.InputBox("Sélectionnez la cellule :", "Nouveau nom de la photo")
If nom = False Then Exit Sub
dossier = Application.InputBox("Sélectionnez la cellule :", "Nouveau dossier")
If dossier = False Then Exit Sub
On Error Resume Next
extension = Mid(fichier, InStrRev(fichier, "."))
FileCopy fichier, dossier & "\" & nom & extension
MsgBox "La copie du fichier " & IIf(Err, " a échoué !", " a réussi...")
End Sub
1ère cellule : nom complet du fichier avec chemin et extension.

2ème cellule : nouveau nom sans chemin ni extension.

3ème cellule : chemin du dossier de destination sans slash \ à la fin.

A+
 

francis Hollard

XLDnaute Nouveau
Bonjour Job75,

Merci pour ta réponse, 9a marche nickel.
Par contre si je ne veux pas de fenêtre poue selectioner et que ça s’exécute automatiquement qu'est-ce que je dois modifier. Je pense que c'est "Application.InputBox(", mais est-ce que je mets les cellules directement?

Cdt.
 

job75

XLDnaute Barbatruc
Bonjour francis Hollard,

C'est certain, si les 3 cellules sont toujours les mêmes pas besoin d'InputBox :
VB:
Sub CopierFichier()
On Error Resume Next
FileCopy [A1], [A3] & "\" & [A2] & Mid([A1], InStrRev([A1], "."))
MsgBox "La copie du fichier " & IIf(Err, " a échoué !", " a réussi...")
End Sub
En A1 : nom complet du fichier avec chemin et extension.

En A2 : nouveau nom sans chemin ni extension.

En A3 : chemin du dossier de destination sans slash \ à la fin.

A+
 
Ce message a été identifié comme étant une solution!

francis Hollard

XLDnaute Nouveau
Re Job75,

C'est super, merci beaucoup c'est exactement ce que je voulais.
Merci de ton aide.
je ne connaissais pas "Filecopy" et du coup je me compliquais la tache.

Encore merci.
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas