Image selon URL dans un MsgBox

Le 10/09/2021 à 09:37

Bonjour,

Je vois pas mal d'anciens posts pour afficher une image dans un MsgBox mais je tombe sur de nombreux codes obsolètes sur ma version et pas exactement la même problématique.
Voilà le code sur lequel je me base en espérant déjà que ca pose problème ^^

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("F11:F400")) Is Nothing Then
MsgBox "Bonjour"
ActiveSheet.Shapes("MON_Image").Visible = True
End If
End Sub

J'aimerai donc que lors d'un double clic sur une cellule de la plage F11 à F400 un Msg box s'affiche avec une image dont le lien (en local C:/...) est différent pour chaque cellule et ce lien se trouve 4 cellules à droite de la cellule sélectionnée (dans la colonne J qui est masquée).

Est-ce faisable assez facilement avec cette base de code ?
ou alors je n'y suis pas du tout ^^

Merci d'avance !

Le 10/09/2021 à 15:01

Bonjour,

Le plus facile est de :

> Insérer un Userform dans VBEditor (le nommer Userform1),

> Y placer un contrôle Image (le nommer Image1),

Le code devient alors :

Pour la feuille :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("F11:F400")) Is Nothing Then
  Userform1.Pic = Target.Offset(0, 4).Value
  Userform1.Show
End If
End Sub

Pour L'Userform :

Public Pic As String

Private Sub UserForm_Activate()
    Userform1.Image1.Picture = LoadPicture(Pic)
End Sub

Après, il y aura plein d'ajustements à faire : taille et position de l'userform, de l'image, format des images acceptées (jpg, gif, ...) etc...

Mais teste déjà ça.

Le 10/09/2021 à 17:13

Bonjour pijaku, ca fonctionne nickel.
Mais en effet l'image apparait très zoomée sur une portion, on peut lui donner une dimension précise ? C'est uniquement des image en jpg.

Petit détail : Et autre point, vu que je demande un double clic sur un tableau dynalmique, quand je ferme la msgBox il y a aussitôt une autre boite qui s'ouvre à s'avoir les détails du tableau dynamique. Bon en soit on fait annuler aussitôt et c'est bon mais si au cas où au passage une petite ligne pouvait éviter d'afficher cette boite après fermeture.

Merci!

capture
Le 10/09/2021 à 21:30

Bonsoir,

Je suis hors réseau ce week end.

Faites moi une petite relance lundi matin, sauf si quelqu'un d'autre prend en charge ce sujet...

Bon week-end

Le 13/09/2021 à 08:20

Bonjour,

1- l'image, le code de l'UserForm devient :

Public Pic As String

Private Sub UserForm_Activate()
    Userform1.Image1.Picture = LoadPicture(Pic)
    Userform1.Image1.PictureSizeMode = fmPictureSizeModeStretch
End Sub

2- Le tableau dynamique : pas compris la question...

Le 13/09/2021 à 09:09

Bonjour,

En fait, sa macro se lance suite à un double clic dans un TCD, ce qui a pour effet de créer une nouvelle feuille avec les donnés qui ont permis de construire cette ligne du TCD, comportement classique d'Excel.

Tu peux essayer de mettre cancel = true

Avant la ligne if not...

Le 13/09/2021 à 16:40

Bonjour,

Bien vu Joyeux Noël.

Je n'avais pas compris qu'il s'agissait d'un TCD, mais pensais à un tableau...

En effet, le Cancel = True règle le souci :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("F1:F21")) Is Nothing Then
    Cancel = True
    UserForm1.Pic = Target.Offset(0, 4).Value
    UserForm1.Show
End If
End Sub
Le 13/09/2021 à 17:17

Bonjour !
Merci pour vos réponses !
Finalement j'ai décidé que pour la fluidité de l'usage, j'allais faire apparaitre l'image à droite du tableau dans le classeur plutôt qu'un useforme.
Cela donne le code suivant

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'D abord on  actualise la table
Application.EnableEvents = False
Sheets("Stock restant").PivotTables("STOCK").RefreshTable 'On actualise le tableau dynamique TCD qui donne les résultats en temps réel
Application.EnableEvents = True

Dim Img As Object 'On supprime ensuite toutes les images de la feuille avant de continuer
For Each Img In ActiveSheet.Pictures
    Img.Delete
Next Img

'On active la troisième cellule à droite de celle où on a fait le double clic
ActiveCell.Offset(rowOffset:=0, columnOffset:=3).Activate

For Each cel In Selection 'Pour chaque cellule (bon ici 1 seule) sélectionnée
  If IsFile(cel.Value) = 0 Then 'On vérifie que le lien qu'il contient n'est pas nulle
Range("J2").Value = "Photo non dispo"
         Exit Sub 'Sinon on arrête là.
           Else
           Set Image = ActiveSheet.Pictures.Insert(cel.Value) 'Si c'est ok, on va chercher l'image dans SSD
            With Image
                 .ShapeRange.LockAspectRatio = msoTrue 'et on l'inclue telle quelle
                .Left = Range("J2").Offset(0, 0).Left 'l'image se place en J2
                .Top = Range("J2").Offset(0, 0).Top 
            End With
End If
Cells(1, 10).Value = cel.Offset(0, -3) 'En J1 on rappelle le nom de ce qui a été cliqué initialement (3 cases à gauche de la sélection)
Next cel
End sub

Function IsFile(fName As String) As Boolean 'Fonction faisant fonctionner la recherche du fichier image lu dans le lien
    On Error Resume Next
   IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
    End Function

Je sais que c'est pas forcément hyper propre car c'est l'association de plusieurs codes que j'ai trouvé mais cela fonctionne !
Après s'il y a des optimisations importantes je suis preneur ^^

Rechercher des sujets similaires à "image url msgbox"