VBA insert image from url and lock original aspect ratio even when resizing columns and rows

ojkaiko

New Member
Joined
Apr 26, 2022
Messages
1
Office Version
  1. 2016
Platform
  1. MacOS
Hello there

I found myself using VBA for the first time because I'm trying to reach the goal of inserting an image from a url and then locking the original aspect ratio even when resizing columns and rows.

I apologize in advance for my complete lack of knowledge, I would really appreciate it if anyone can please help me out!

The code I got from someone on youtube is this:

VBA Code:
Sub InsertImageVideo()

Dim pic As String
Dim myPicture As Picture
Dim rng As Range
Dim item As Range

Set rng = Range("k2:k100")
For Each item In rng
    pic = item.Offset(0, 1)
    If pic = "" Then Exit Sub
        Set myPicture = ActiveSheet.Pictures.Insert(pic)
        
        With myPicture
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = item.Width
        .Height = item.Height
        .Top = Rows(item.Row).Top
        .Left = Columns(item.Column).Left
        .Placement = xlMoveAndSize

        
    End With
    
Next

        


End Sub






••••ˇˇˇˇ

But that doesn't really perfectly work for me becuase some of my images from the url are portrait and some are landscape, in fact most of them have different aspect ratios.

The first issue is that this code inserts the image filling up the width and height of the cell (which is distorting the image now) so they either look too fat or too narrow. I want them to be inserted with their original aspect ratio. However within the maximum capacity of the cell size.

The 2nd issue is that if I resize the column left or right, it will stretch the image, same goes with dragging the row up or down. I want excel to only scale up or down the size of the image if only there is enough room for the aspect ratio to scale up or down. This means I would have resize both column and row for that, and thats fine for me.

Any help would be appreciated, and I apologize for my lack of knowledge!
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
2,997
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
See the lines marked <<<; I think those modifications should address your concerns:
VBA Code:
        With myPicture
            .ShapeRange.LockAspectRatio = msoTrue    '<<< msoFalse
            .Width = item.Width
            If .Height > item.Height Then .Height = item.Height    '<<<
            .Top = Rows(item.Row).Top
            .Left = Columns(item.Column).Left
            .Placement = xlFreeFloating        ''<<<  xlMoveAndSize
        End With
Bye
 

Forum statistics

Threads
1,176,512
Messages
5,903,474
Members
435,031
Latest member
traceson

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top