Macro pour insertion automatique d'images venant d'une URL / Excel 2016

Résolu
Roi_Burgonde Messages postés 24 Statut Membre -  
Roi_Burgonde Messages postés 24 Statut Membre -
Bonjour tout le monde,

Je suis commercial et je cherche à améliorer un outil afin de diffuser de l'info simplement auprès de mes clients.

J'aimerais que, dans la configuration ci-dessous, la cellule A16, contenant une URL d'image, affiche l'image en question à l'aide d'une macro :


Dimensions cellule : 280 x 207 pixels

J'ai tenté de mettre en pratique et d'adapter les conseils sur ce sujet : https://forums.commentcamarche.net/forum/affich-3596617-insertion-automatique-d-images-sous-excel
Mais sans succès (je débute avec les macros :o !)

Autre point : est-ce possible, au lieu d'attribuer un raccourci clavier, de mettre deux boutons :
- L'un pour générer les images en fonction des URL
- L'autre pour supprimer ces images (ou alors Ctrl+Z suffit amplement et je me fais des noeuds au cerveau pour rien ?)

D'avance merci !

A.

7 réponses

  1.
    cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    voir ceci:

    https://borntocode.fr/excel-inserer-une-image-depuis-un-lien-hypertexte-macro/

    1
    1. Roi_Burgonde Messages postés 24 Statut Membre
       
      Bonjour,
      Merci pour le lien, je viens de tester mais le débogueur me surligne la ligne N°7...

      De plus j'ai un problème : l'image insérée redimensionne totalement la cellule, au lieu de s'adapter à la cellule fusionnée.
      Je me suis probablement planté sur les dimensions en pixels (les pixels indiqués dans mon message initial sont en fonction des largeurs des colonnes et hauteurs des lignes).
      Lorsque l'image s'affiche, sa taille semble bonne, mais toutes les largeurs et hauteurs des lignes sélectionnées changent.

      Est-ce possible de compenser ce point ?

      Merci !
      0
      1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730 > Roi_Burgonde Messages postés 24 Statut Membre
         
        Avec des cellules fusionnées c'est différent.

        a mettre dans un module et faire des raccourcis clavier pour lancer les 2 macros

        insertionimage et delete 

        Option Explicit
'insere image
Sub insertionimage()
Dim plage As Range
Set plage = Range("A16:D24") ' a adapter
place_l_image_dans plage, ActiveSheet.Pictures.Insert(Range("A16").Value) ' a adapter
End Sub
'la sub calcule en touchant a la shape
Sub place_l_image_dans(RnG As Range, Shp As Picture)
      Dim ratio, w, h
      With Shp
        .ShapeRange.LockAspectRatio = msoTrue    ' lock leratio indéformable
        ratio = .Width / .Height     ' calcul ratio
        w = RnG.Width       ' width  range
        h = RnG.Height      ' height range
        .Height = h - (2 / ratio)
        .Left = RnG.Left + ((RnG.Width - .Width) / 2)
        .Top = RnG.Top + ((RnG.Height - .Height) / 2)
        .Placement = 1
    End With
End Sub
'supprime image
Sub delete()
Dim x As Shape
 For Each x In ActiveSheet.Shapes
        If x.Type = msoPicture Then x.delete
    Next x
End Sub


        @+ Le Pivert
        0
  2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour

    Un exemple de récupération d'images (matos de tuyauterie...) il faut connaitre la référence de l'image à télécharger par ex: 3456.jpg. les images du site semettent au format de la cellule de réception

    https://mon-partage.fr/f/SDpQUH33/
    0
    1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      Bonjour michel_m

      De plus j'ai un problème : l'image insérée redimensionne totalement la cellule, au lieu de s'adapter à la cellule fusionnée.

      le problème se pose au niveau des cellule fusionnées!


      @+ Le Pivert
      0
  3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour Le Pivert

    Il faudrait que Roi Burgonde joigne son classeur sur Cjoint.com pour regarder si on peut défaire les fusions ( le coup classique du "centrer sur plusieurs colonnes mais...)

    Bon WE à toi malgré le confinement

    Cordialement
    -1
  4. Roi_Burgonde Messages postés 24 Statut Membre
     
    Bonjour à vous deux,

    Merci pour vos réponses !
    Voici le lien : https://www.cjoint.com/c/JEbpyYDuSa1

    C'est sur l'onglet IZI que ça se passe :o

    D'avance merci !
    0
    1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      Bonjour,

      voir si cela convient,

      https://www.cjoint.com/c/JEcgJsDElqQ



      @+ Le Pivert
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Roi_Burgonde Messages postés 24 Statut Membre
     
    Ooh !

    C'est super pour l'insertion des images ! Je n'ai plus besoin des autres macro et juste besoin d'adapter celle-ci si j'y arrive.

    J'ai deux questions :
    - Je n'arrive pas à exécuter la macro pour effacer les images (ni en faisant exécuter ni en faisant Ctrl+w), savez-vous à quoi cela peut être du ?
    - Dans la macro d'insertion d'images, je vois que c'est de A à D ; est-il possible d'adapter cette commnande pour pouvoir faire la même chose mais en ligne (à partir de la colonne AG) ? Je peux remplacer les colonnes A et D par lignes 4 à 8 ?

    En tous cas un très grand merci !

    A.
    0
    1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      Pour la 1 ère question changer le raccourci comme ceci:

      Allez dans Développeur Sélectionnez Macro, Option

      voir capture:



      Pour la seconde question, ce ne sont pas des lignes mais des cellules fusionnées. donc je ne comprends pas la question!

      @+ Le Pivert
      0
  7. Roi_Burgonde Messages postés 24 Statut Membre
     
    Le Pivert,

    - Pour la première question, ce n'est pas tant le problème de raccourci que de la commande qui ne s'exécute pas (même en passant par Affichage > Macro > Afficher les macros > Exécuter), c'est cela qui me pose problème :o

    - La deuxième question concerne les cellules fusionnées (AG4 à AI8), j'aimerais pouvoir faire pareil

    - Autre difficulté, si je copie / colle dans un mail Outlook, la mise en page n'est plus bonne. Est-ce que je dois mettre l'URL de l'image dans une cellule séparée afin que cela ne gène pas la mise en forme en collant ?

    Merci !
    0
    1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      Pour la première question associer à un bouton

      J'ai compris la 2ème question. Je n'avais pas vu qu'il y avait d'autres images!

      remplacer le code par celui là: 

      Option Explicit
'se déclenche au clic droit pour insérer une image
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'colonne A
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
Dim ligne As Long
Dim colonne As Integer
Dim coldebut As String
Dim colfin As String
 ligne = ActiveCell.Row
 Dim plage As Range
On Error Resume Next
Set plage = Range("A" & ligne & ":D" & ligne + 8) ' chemin complet du lien
place_l_image_dans plage, ActiveSheet.Pictures.Insert(Range("A" & ligne).Value) ' chemin complet du lien
 End If
 'colonne de AG à BG
 If Not Application.Intersect(Target, Range("AG:BG")) Is Nothing Then
 colonne = ActiveCell.Column
 coldebut = Col2Let(colonne)
 colfin = Col2Let(colonne + 2)
On Error Resume Next
Set plage = Range(coldebut & 4 & ":" & colfin & 8) ' chemin complet du lien
place_l_image_dans plage, ActiveSheet.Pictures.Insert(Range(coldebut & 4).Value) ' chemin complet du lien
 End If
End Sub
'conversion colonne chiffre en lettre
Public Function Col2Let(ByVal numCol As Long) As String
Col2Let = Split(Cells(, numCol).Address, "$")(1) '$A$1
End Function
'la sub calcule en touchant a la shape
Sub place_l_image_dans(RnG As Range, Shp As Picture)
      Dim ratio, w, h
      With Shp
        .ShapeRange.LockAspectRatio = msoTrue    ' lock leratio indéformable
        ratio = .Width / .Height     ' calcul ratio
        w = RnG.Width       ' width  range
        h = RnG.Height      ' height range
        .Height = h - (2 / ratio)
        .Left = RnG.Left + ((RnG.Width - .Width) / 2)
        .Top = RnG.Top + ((RnG.Height - .Height) / 2)
        .Placement = 1
         .Name = "monimage"
    End With
End Sub


      Pour la 3 ème question qui n'a rien a voir avec ce post, ouvrir un nouveau post

      @+ Le Pivert
      0
  8. Roi_Burgonde Messages postés 24 Statut Membre
     
    Je fais cela immédiatement. Merci encore !
    0