Image automatique selon lien
Bonjour,
Je cherche sans succès comment faire apparaître des photos dans une feuille.
J'ai 4 formules créant des lien hypertexte (exemple des formules dans le fichier joint)
Et je souhaite que les 4 photos associés à ces liens s'affiche dans les espaces alloué (voir fichier joint)
Votre aide sera apprécié
fichier joint
Bonjour,
Une autre piste en liant la sub ci-dessous à un bouton "Formulaire" :
Sub Photo()
Dim Chemin As String
Dim Tbl
Dim I As Integer
With ActiveSheet
Chemin = .Range("C1").Value & .Range("C2").Value & .Range("C3").Value
Tbl = Array(.Range("C4").Value, .Range("C5").Value, .Range("C6").Value, .Range("C7").Value, _
"PHOTOR", "PHOTOS", "PHOTOV", "PHOTOP")
For I = 0 To UBound(Tbl)
Fe.Shapes.AddPicture Chemin & Tbl(I), _
msoFalse, _
msoTrue, _
.Shapes(Tbl(I + 4)).Left, _
.Shapes(Tbl(I + 4)).Top, _
.Shapes(Tbl(I + 4)).Width, _
.Shapes(Tbl(I + 4)).Height
Next I
End With
End SubMerci Theze de ton aide,
J'ai copier ton code dans le VBA de la feuille
J'ai ajouté un bouton sur ma feuille et j'ai lié la macro au bouton
Je reçois un message "Objet requis"
Merci tulipe_4
J'ai plus de 20000 photos...
Je veux en afficher 4 selon le numéro de dossier....
Donc je ne peux coller des miniatures ...
je dois avoir un système qui les récupères en fonction des lien que je crée par formule
Bonjour,
Je n'avais fais aucun test avec le code final mais le voici corrigé et qui fonctionne enfin, chez moi du moins :
Sub Photo()
Dim Chemin As String
Dim Tbl
Dim I As Integer
With ActiveSheet
Chemin = .Range("C1").Value & .Range("C2").Value & .Range("C3").Value
Tbl = Array(.Range("C4").Value, .Range("C5").Value, .Range("C6").Value, .Range("C7").Value, _
"PHOTOR", "PHOTOS", "PHOTOV", "PHOTOP")
For I = 0 To 3
.Shapes.AddPicture Chemin & Tbl(I), _
msoFalse, _
msoTrue, _
.Shapes(Tbl(I + 4)).Left, _
.Shapes(Tbl(I + 4)).Top, _
.Shapes(Tbl(I + 4)).Width, _
.Shapes(Tbl(I + 4)).Height
Next I
End With
End SubBonjour Theze,
J'obtiens une erreur 400 !
Bonjour Mtek,
tu a écrit :J'obtiens une erreur 400 !
ajoute 21, et tu pourras gagner au jeu du 421 !
sérieux, les messages d'erreur, y'en a plein ! et on les connaît pas tous par cœur !
alors quel est le texte exact du message d'erreur indiqué ?
dhany
Bonjour,
Dans le code ci-dessous, j'ai séparé le tableau en deux tableaux et les chemins complets sont maintenant récupérés dans les cellules C8 à C11 !
Si tu as encore une erreur, fais savoir sur quelle ligne de code et poste le classeur sur lequel tu fais le test si différent du premier :
Sub Photo()
Dim TblNom
Dim TblCible
Dim I As Integer
With ActiveSheet
TblNom = Array(.Range("C8").Value, .Range("C9").Value, .Range("C10").Value, .Range("C11").Value)
TblCible = Array("PHOTOR", "PHOTOS", "PHOTOV", "PHOTOP")
For I = 0 To 3
.Shapes.AddPicture TblNom(I), _
msoFalse, _
msoTrue, _
.Shapes(TblCible(I)).Left, _
.Shapes(TblCible(I)).Top, _
.Shapes(TblCible(I)).Width, _
.Shapes(TblCible(I)).Height
Next I
End With
End SubBonjour Theze
Avec le nouveau code, j'obtiens l'erreur '1004' lorsque je l'exécute en mode pas-à-pas
après le bloc
.Shapes.AddPicture Chemin & Tbl(I), _
msoFalse, _
msoTrue, _
.Shapes(Tbl(I + 4)).Left, _
.Shapes(Tbl(I + 4)).Top, _
.Shapes(Tbl(I + 4)).Width, _
.Shapes(Tbl(I + 4)).Heightet j'obtiens l'erreur 400 lorsque je l'exécute à partir du bouton (formulaire)
Bonjour,
Tu as dû remarquer que dans le nouveau code c'était :
.Shapes.AddPicture TblNom(I), _
msoFalse, _
msoTrue, _
.Shapes(TblCible(I)).Left, _
.Shapes(TblCible(I)).Top, _
.Shapes(TblCible(I)).Width, _
.Shapes(TblCible(I)).Heightet non :
.Shapes.AddPicture Chemin & Tbl(I), _
msoFalse, _
msoTrue, _
.Shapes(Tbl(I + 4)).Left, _
.Shapes(Tbl(I + 4)).Top, _
.Shapes(Tbl(I + 4)).Width, _
.Shapes(Tbl(I + 4)).Heightil y a deux tableaux, TblNom() qui contient les chemins et noms des fichiers images et TblCible() qui contient les Shapes que doivent superposer les images donc, ce n'est plus Chemin & Tbl(I) mais TblNom(I) et non plus Tbl(I + 4) mais TblCible(I)
MERCIIIIIIIIIIIII
C'est les chemins vers les photos qui faisait défaut.
Encore une fois, mille et un merci
Content de t'avoir aidé !
Bonjour Theze
Je suis tombé (enfin) sur ce qui semble être une très bonne solution pour le petit fichier que je souhaite mettre en place.
J'ai une petite demande concernant l'édition de nouvelle fiche.
Je souhaiterais pouvoir effacer les nouvelles images introduites dans la feuille.
En appliquant ta macro, ce sont à chaque fois des nouvelles "Picture" qui s'introduisent.
J'ai essayé d'effectuer une macro manuelle et le résultat et le suivant:
ActiveSheet.Shapes.Range(Array("Picture 44")).Select
Selection.Delete
Evidemment que ça serait trop simple. Mais comme tu t'en doute, les Picture ont une nouvelle numérotation à chaque fois.
Existe-t-il un moyen d'obliger la numérotation de "Picture 1" à "Picutre 4" ?
Ou
Existe-t-il moyen de faire effacer les "Picture" indépendamment de leur numéro ?
D'avance merci (en espérant que ce fil ne soit pas trop vieux et que tu le lises encore