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

[Résolu/Fermé]
Signaler
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021
-
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021
-
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

Messages postés
7531
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
16 septembre 2021
655
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 42854 internautes nous ont dit merci ce mois-ci

Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

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 !
Messages postés
7531
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
16 septembre 2021
655 >
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

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
Messages postés
16506
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 septembre 2021
3 220
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/
Messages postés
7531
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
16 septembre 2021
655
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
Messages postés
16506
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 septembre 2021
3 220
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
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

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 !
Messages postés
7531
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
16 septembre 2021
655
Bonjour,

voir si cela convient,

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



@+ Le Pivert
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

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.
Messages postés
7531
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
16 septembre 2021
655
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
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

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 !
Messages postés
7531
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
16 septembre 2021
655
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
Messages postés
24
Date d'inscription
mercredi 15 avril 2020
Statut
Membre
Dernière intervention
18 février 2021

Je fais cela immédiatement. Merci encore !