Affiche photo selon lien

Même soucis qu'avant... je commence à douter qu'excel vois une formule comme une valeur !

Le chemin en B31 est créer par une formule

Lorsqu'en B31 il n'y a pas de chemin, il y reste quand même la formule....

le problème est lorsque qu'il y a un lien, la photo s'affiche bien en C17, mais lorsque il n'y a pas de lien (créer par la formule) en B31, la photo d'avant ou celle qui y était affiché reste affiché... faudrais qu'elle soit effacé ou mit à visible = false si pas de chemin en B31 ( mais la formule y est )

encore une fois, merci de vous penchez sur mon problème

Oui, je t'avais justement posé la question car je craignais la formule...

Et en essayant ces 2 codes :

'MODULE DE LA FEUILLE CONCERNEE
private sub worksheet_calculate()
on error resume next
if range("B31").value = "" then
    shapes(spath).visible = false
else
    spath = range("B31").value
    shapes(spath).visible = true
end if
if err.number = 9 then
    on error goto 0
    call AjoutImage(spath)
end if
end sub

'MODULE NORMAL
Public spath$
Sub AjoutImage(chemin$)
if chemin = "" then exit sub
if dir(chemin) = "" then msgbox "Image introuvable, vérifiez le chemin !", vbcritical: exit sub
With ThisWorkbook.Worksheets("Feuil1").Shapes
    .AddPicture(chemin, False, True, Range("C17").Left, Range("C17").Top, 241.5, 180.75).name = chemin
End With
End Sub

toujours avec le premier dans le module de la feuille concernée.

Edit : code modifié, à tester...

Cdlt,

@3GB

La photo disparait lorsque le chemin (B31) = rien.... mais n'affiche pas la photo lorsque en B31 il y a un lien valide

Re Mtek,

Peux-tu essayer ces codes :

'MODULE DE LA FEUILLE
private sub worksheet_calculate()

chemin = NomImage("$C$17")
If chemin = Range("B31").Value Then
    Exit Sub
Else
    If chemin <> "" Then Shapes(chemin).Delete
End If

If Range("B31").Value = "" Then Exit Sub Else chemin = Range("B31").Value

If Dir(chemin) = "" Then MsgBox "Image introuvable, vérifiez le chemin !", vbCritical: Exit Sub
With ThisWorkbook.Worksheets("Feuil1").Shapes
    .AddPicture(chemin, False, True, Range("C17").Left, Range("C17").Top, 241.5, 180.75).Name = chemin
End With

End Sub

'MODULE NORMAL
Function NomImage(sAdresse$) As String
For Each sh In ActiveSheet.Shapes
    If sh.TopLeftCell.Address = sAdresse Then NomImage = sh.Name
Next sh
End Function

Cdlt,

@3GB

Merci pour le temps que tu consacres à mon problème..

Je reçois le message d'erreur
Variable non définie

Je met en commentaire Option Explicit
je reçois l'erreur suivante
End If sans bloc If

J'ai édité le code à l'instant, peux-tu réessayer ?

@3GB

Je dois mettre Option Explicit en commentaire.... variable non définie

Je reçois par la suite un message d'erreur

Je viens de tester de mon côté, ça marche...

Là, je ne vois qu'une seule raison, ce serait que tu aies des formes sur ta feuille qui ne soient pas liées à des cellules !?

Voici un nouvel essai avec les variables cette fois-ci :

'MODULE DE LA FEUILLE
private sub worksheet_calculate()

dim chemin$

chemin = NomImage("$C$17")
If chemin = Range("B31").Value Then
    Exit Sub
Else
    If chemin <> "" Then Shapes(chemin).Delete
End If

If Range("B31").Value = "" Then Exit Sub Else chemin = Range("B31").Value

If Dir(chemin) = "" Then MsgBox "Image introuvable, vérifiez le chemin !", vbCritical: Exit Sub
With ThisWorkbook.Worksheets("Feuil1").Shapes
    .AddPicture(chemin, False, True, Range("C17").Left, Range("C17").Top, 241.5, 180.75).Name = chemin
End With

End Sub

'MODULE NORMAL
Function NomImage(sAdresse$) As String
dim sh as shape, r as range
For Each sh In ActiveSheet.Shapes
    set r = sh.TopLeftCell
    if not r is nothing then
        If r.Address = sAdresse Then NomImage = sh.Name
    end if
Next sh
End Function

Cdlt,

@3GB

Même message :-(

Question....

Ce code fonctionne

        With ThisWorkbook.Worksheets("COMMANDE").Shapes
            On Error Resume Next
            .AddPicture Range("B31").Value, False, True, Range("C17").Left, Range("C17").Top, 241.5, 180.75
        End With

est-il possible d'effacer le contenue (image) qui se trouve en C17 avant d'exécuter ce code ?

je pense que mon problème serait réglé

Bonjour,

Voilà, nous on partait à l'essentiel, tranquilou, et 3GB vient nous mettre le bazar avec toutes ses améliorations....

Pffff 😁

Sur quelle ligne exactement ? Je peux voir le code en entier ?

Bah justement, c'est ce que fait la fonction, elle cherche le nom de l'image en C17 (le nom pouvant être variable). Ensuite, on efface cette image (quand changement) pour en insérer une autre.

Sur mon fichier, ça marche très bien, le code est exactement le même, je n'ai rien retouché (à l'avant dernier code). Et là, je ne vois pas bien la raison, à moins que tu aies modifié le code...

Salut JoyeuxNoel,

Loool, c'est vrai que c'était simple, court et efficace ! Je pensais que ça allait marcher directement mais... non . Ce sont des améliorations qui détériorent !

La seule chose que je modifie de ton code est le nom de la feuille.... feuil1 -> COMMANDE

Je te propose un nouvel essai alors, en plaçant le code dans le module de la feuille COMMANDES.

'MODULE DE LA FEUILLE
private sub worksheet_calculate()

dim chemin$

chemin = NomImage("$C$17")
If chemin = Me.Range("B31").Value Then
    Exit Sub
Else
    If chemin <> "" Then Me.Shapes(chemin).Delete
End If

If Me.Range("B31").Value = "" Then Exit Sub Else chemin = Me.Range("B31").Value

If Dir(chemin) = "" Then MsgBox "Image introuvable, vérifiez le chemin !", vbCritical: Exit Sub
With Me.Shapes
    .AddPicture(chemin, False, True, Me.Range("C17").Left, Me.Range("C17").Top, 241.5, 180.75).Name = chemin
End With

End Sub

'MODULE NORMAL
Function NomImage(sAdresse$) As String
dim sh as shape
For Each sh In Sheets("COMMANDES").Shapes
    if sh.type = msopicture then
        If sh.TopLeftCell.Address = sAdresse Then NomImage = sh.Name
    end if
Next sh
End Function

Je vais faire un petit test de mon côté.

Edit : J'ai rencontré le bug avec la présence d'une liste déroulante. Code édité !

Bonsoir JoyeuxNoël, 3GB,

si cela peut vous aider : StellSon

@ bientôt

LouReeD

Bonjour,

Quoi ? On aurait essayé de réinventer la poudre ? ☺️

Bonjour à tous,

Oui, je réinvente la farine, peut-être qu'un jour j'arriverais à faire du pain ! Mais bon, cette fois-ci, il s'agit de Steelson et non de Microsoft Excel, je ne pouvais pas savoir qu'il avait déjà fait un fichier qui traite cette question...

@Mtek : Ca marche ou pas alors ?

Cdlt,

@3GB
Bon matin,

Je recois une erreur d'exécution '52'

"Nom ou numéro de fichier incorrect"

En cliquant sur deboggage, la ligne qui était sur-ligné en jaune, je l'ai mis en commentaire

If Dir(chemin) = "" Then MsgBox "Image introuvable, vérifiez le chemin !", vbCritical: Exit Sub

Et suite à ça, ça semble fonctionner parfaitement :-)

Un méga merci, ton aide, ta patience et ta persévérance on permit de résoudre le problème

Salut Mtek,

Tu dois être canadien pour nous souhaiter un bon matin à 13 heures (heure française).

Merci de ton retour.

Peux-tu me donner un exemple de valeur en B31 ? J'avais prévu le chemin complet et j'ai l'impression que le fait d'avoir un chemin incomplet est la cause de l'erreur 52. Si ça marche tant mieux mais ça pourrait être utile par la suite d'avoir ce petit contrôle à la place d'un bug...