XL 2010 Image de substitution

jigour · 21 Septembre 2023

Bonsoir,
Quand j'ouvre ma fiche article excel va me chercher une image qui porte le même nom que mon code article.
Jusque la ça fonctionne , mais si l'image n'existe pas dans le fichier il y a un message , et je trouve cela pas très .....élégant !!
Ce que je souhaite c'est avoir un code qui ouvre une image "de subsitution" a la place des images manquantes .
Pensez vous que ce soit possible?

Phil69970 · 22 Septembre 2023

Bonjour @jigour

Oui mais il manque le fichier

Dranreb · 22 Septembre 2023

Bonsoir.
On peut en général éviter le message d'erreur d'exécution en mettant On Error Resume Next devant l'instruction qui risque de la provoquer.
Testez ensuite l'objet Err pour savoir si une action de remplacement s'impose.
Enfin annulez la disposition par On Error GoTo 0

jigour · 22 Septembre 2023

Merci @Phil69970
Merci Dranreb
Je ne vais pas joindre le fichier ce soir mais un bout du code concerné .....Je commence a fatiguer!!
J'espère que ça peu suffire.

Sub insert_photo()
Feuil1.Select

Dim Lign As Integer
Dim chemin As String
Dim nomimage As String
Dim image As String

chemin = "C:\Users\Jean\Pictures\image \"
On Error Resume Next
nomimage = Feuil1.Cells(Lign, 1).Value
image = ".jpg"

ActiveSheet.Shapes.AddPicture Filename:=chemin & nomimage & image, linktofile:=msoFalse, _
savewithdocument:=msoTrue, Left:=240, Top:=50, Width:=210, Height:=160

End Sub

Phil69970 · 22 Septembre 2023

Re

Je te propose ma solution dans un module (non testée car pas de fichier)

VB:

Function testFichier(fichier As String) As Boolean
If Len(Dir(fichier)) > 0 Then
    testFichier = True
Else
    testFichier = False
End If
End Function

Sub insert_photo()
Feuil1.Select

Dim Lign&, Chemin$, Nom_Image$, Ext$, MonImage$

Chemin = "C:\Users\Jean\Pictures\image \"  'Est il normal d'avoir un espace apres image ?
Nom_Image = Feuil1.Cells(Lign, 1).Value
Ext = ".jpg"

MonImage = Chemin & NomImage & Ext

If testFichier(MonImage) Then
    'L'image existe sur le DD
    ActiveSheet.Shapes.AddPicture Filename:=MonImage, linktofile:=msoFalse, _
    savewithdocument:=msoTrue, Left:=240, Top:=50, Width:=210, Height:=160
Else
    'L'image n'existe pas sur le DD
    'Mon image de substitution et mon action
    'Blablabla....
End If
End Sub

Merci de ton retour

jigour · 22 Septembre 2023

Bonjour,
Je testerais ça lundi , pour le moment j'ai utiliser la formule prposée par Dranreb .
Elle laisse un vide , mais c'est bien comme ça aussi.
Merci et Bon week end

Dranreb · 22 Septembre 2023

Bonjour.
Juste avant la End Sub faire: If Err Then ActiveSheet.Shapes.AddPicture Filename:=ImageDeSubstitution

XL 2010 Image de substitution

jigour

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

jigour

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

jigour

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Discussions similaires