CODEWITHSUNDEEP
vbaimagemacosurl
Carl
Carl

Reputation: 21

Inserting a picture from a url in Excel for Mac 2016

I'm trying to insert a picture from a url in excel for Mac. The url is in cell l2 and need the url converted and a picture placing in cell n2 and so on for 1500 cells. I can not figure out how to do this.

Screen shot of the problem

enter image description here

Upvotes: 0

Views: 1934

Answers (2)

吉田裕範
吉田裕範

Reputation: 21

In Version: 16.16.13 (190811), it was possible to acquire images with the following code.

  Dim url as Variant
  j = 1

  With ActiveSheet.Pictures.Insert(url)
    With .ShapeRange
      .LockAspectRatio = msoTrue
      .Width = 75
      .Height = 100
    End With
    .Left = ActiveSheet.Cells(j + 1, 1).Left
    .Top = ActiveSheet.Cells(j + 1, 1).Top
    .Placement = 1
    .PrintObject = True
  End With

  j=j+1

However, unblock external content in Office documents is required. https://support.office.com/en-us/article/block-or-unblock-external-content-in-office-documents-10204ae0-0621-411f-b0d6-575b0847a795

Upvotes: 1

ASH
ASH

Reputation: 20302

One of these options should work for you. Simply change the path from the C-drive to your URL..

Sub InsertPics()
Dim fPath As String, fName As String
Dim r As Range, rng As Range

Application.ScreenUpdating = False
fPath = "C:\Users\Public\Pictures\Sample Pictures\"
Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
i = 1

For Each r In rng
    fName = Dir(fPath)
    Do While fName <> ""
        If fName = r.Value Then
            With ActiveSheet.Pictures.Insert(fPath & fName)
                .ShapeRange.LockAspectRatio = msoTrue
                Set px = .ShapeRange
                If .ShapeRange.Width > Rows(i).Columns(2).Width Then .ShapeRange.Width = Columns(2).Width
                    With Cells(i, 2)
                        px.Top = .Top
                        px.Left = .Left
                        .RowHeight = px.Height
                    End With
            End With
        End If
        fName = Dir
    Loop
    i = i + 1
Next r
Application.ScreenUpdating = True
End Sub

' Note: you need the file extension, such as ',jpg', or whatever you are using, so you can match on that.

Sub Insert()

    Dim strFolder As String
    Dim strFileName As String
    Dim objPic As Picture
    Dim rngCell As Range

    strFolder = "C:\Users\Public\Pictures\Sample Pictures\" 'change the path accordingly
    If Right(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If

    Set rngCell = Range("E1") 'starting cell

    strFileName = Dir(strFolder & "*.jpg", vbNormal) 'filter for .png files

    Do While Len(strFileName) > 0
        Set objPic = ActiveSheet.Pictures.Insert(strFolder & strFileName)
        With objPic
            .Left = rngCell.Left
            .Top = rngCell.Top
            .Height = rngCell.RowHeight
            .Placement = xlMoveAndSize
        End With
        Set rngCell = rngCell.Offset(1, 0)
        strFileName = Dir
    Loop

End Sub

Upvotes: 0

Related Questions