XL 2019 Importer des images depuis un lien ou Google image

dysorthographie à dit:

Bonjours,
Dans le lien suivant tu trouveras la fonction DownloadHTTP qui permet de télécharger un fichier dans une URL.

QR Code | Philben – Ms Access

blog.developpez.com

Cliquez pour agrandir...

patricktoulon à dit:

Bonjour Robert , @metalbarzotti

un exemple j'importe le logo de exceldownloads dans une feuille et je la place dans une plage de cellules et centrée
possibilité de la redimensionner(ou pas ) à la plage en gardant le ratio
possibilité de marger de 1% à 100%
avec ma fonction magique
deux des trois modes sont en commentaire

VB:

Sub test()
    Dim img As Picture, Url$
    'pour l'exemple on va insérer le logo de exceldownloads
    'url de l'image
    Url = "http://excel-downloads.com/styles/brivium/stylium/strontium/xenforo/logo.png"

    'on importe l'image dans la feuille
    Set img = ActiveSheet.Pictures.Insert(Url)

    'on recupere lesdimensions et position  de l'image par ma fonction magique
    'afin qu'elle soit redimentionnée (ou pas) et centrée dans la plage de cellules en parametres

    'exemple sans redimentionnement
    'd = GetDimPositionShapeCenterRange(ActiveSheet.[D4:I10], img, , True)

    'exemple avec  redimentionnement  au max de la plage et sans marge
    'd = GetDimPositionShapeCenterRange(ActiveSheet.[D4:I10], img)

    'exemple avec  redimentionnement  au max de la plage et avec une marge de 10% (100-10 donc <<90%>>)
    d = GetDimPositionShapeCenterRange(ActiveSheet.[D4:I10], img, 90)

    'on place et dimentionne l'image dans la plage de destination
    With img
        .Left = d(0)
        .Top = d(1)
        .Width = d(2)
        .Height = d(3)
        .ShapeRange.Line.Visible = True    'pour que l'on puisse bien voir sa position dans la plage de cellule
    End With
End Sub


Function GetDimPositionShapeCenterRange(rng As Range, shap, Optional PercentMarge As Long = 100, Optional NoRedim As Boolean = False)    'la marge exprime un pourcentage de 1 à x%
'collection fonctions perso Catégorie [IMAGES] by patricktoulon sur exceldownloads
    Dim Ratio#, Wx#, Hy#, Tp#, LfT#
    Ratio = Application.Min(rng.Width / shap.Width, rng.Height / shap.Height)
    If NoRedimXY Then Ratio = 1: PercentMarge = 100
    Wx = (shap.Width * Ratio) * (PercentMarge / 100)
    Hy = (shap.Height * Ratio) * (PercentMarge / 100)
    Tp = rng.Top + ((rng.Height - Hy) / 2)
    LfT = rng.Left + ((rng.Width - Wx) / 2)
    GetDimPositionShapeCenterRange = Array(LfT, Tp, Wx, Hy)
End Function

Cliquez pour agrandir...