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

Résolu/Fermé
Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021 - 29 avril 2020 à 17:20
Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021 - 3 mai 2020 à 23:20
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.
A voir également:

7 réponses

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
29 avril 2020 à 17:34
1
Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021
29 avril 2020 à 19:32
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
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728 > Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021
30 avril 2020 à 09:26
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
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
30 avril 2020 à 11:45
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
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
30 avril 2020 à 11:55
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
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
30 avril 2020 à 14:23
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
0
Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021
1 mai 2020 à 21:59
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
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
2 mai 2020 à 08:36
Bonjour,

voir si cela convient,

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



@+ Le Pivert
0

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

Posez votre question
Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021
2 mai 2020 à 12:25
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
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
2 mai 2020 à 13:36
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
Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021
2 mai 2020 à 14:34
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
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 2 mai 2020 à 16:12
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
Roi_Burgonde Messages postés 24 Date d'inscription mercredi 15 avril 2020 Statut Membre Dernière intervention 18 février 2021
3 mai 2020 à 23:20
Je fais cela immédiatement. Merci encore !
0