Regulate size of imported pictures

Keyser_Soeze

New Member
Joined
Oct 30, 2020
Messages
13
Office Version
  1. 365
Platform
  1. MacOS
Hi!

I'm running a macro that imports pictures from files on my computer, file adress in column A, picture in column B. I've been using code from googling around so I haven't really figured out what's what. I'd like the pictures to be bigger, is there any parameter in the code that regulates the size of the pictures?

Sub InsertPics2() 'Pictures saved with file
'Set column width (ie, pic width) before running macro

Dim r As Range, Shrink As Long
Dim shpPic As Shape
Application.ScreenUpdating = False
Shrink = 0 'Provides negative offset from cell borders when > 0
For Each r In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If r.Value <> "" Then
Set shpPic = ActiveSheet.Shapes.AddPicture(FileName:=r.Value, linktofile:=msoFalse, _
savewithdocument:=msoTrue, Left:=Cells(r.Row, 2).Left + Shrink, Top:=Cells(r.Row, 2).Top + Shrink, _
Width:=-1, Height:=-1)
With shpPic
.LockAspectRatio = msoTrue
.Width = Columns(2).Width - (2 * Shrink)
Rows(r.Row).RowHeight = .Height + (2 * Shrink)
End With
End If
Next r
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Use the Width and Height properties of the shape object. For example if you want to increase the size to 150%

VBA Code:
    With shpPic
        .LockAspectRatio = msoTrue
        .Width = .Width * 1.5
    End With

Note that because the aspect ratio is locked, I only need to adjust width.
 
Upvote 0
Solution
Use the Width and Height properties of the shape object. For example if you want to increase the size to 150%

VBA Code:
    With shpPic
        .LockAspectRatio = msoTrue
        .Width = .Width * 1.5
    End With

Note that because the aspect ratio is locked, I only need to adjust width.
I realized that my problem is the limitation of cell height, I cant make the pics bigger and still fit the cells because of that. Guess there's nothing to do about that. I'll see what I can do with zooming. Thanks a lot anyway!
 
Upvote 0
I realized that my problem is the limitation of cell height, I cant make the pics bigger and still fit the cells because of that. Guess there's nothing to do about that. I'll see what I can do with zooming. Thanks a lot anyway!

Other than make the cell bigger, no. If you want to invest A LOT of work you can theoretically add code to toggle the picture size when clicked.

VBA Code:
Sub Picture1_Click()
    With ActiveSheet.Shapes("Picture 1")
        If .Height = ActiveSheet.Range("A1").Height Then
            .LockAspectRatio = msoTrue
            .Width = 400     'make bigger for viewing
        Else
            .LockAspectRatio = msoTrue
            .Height = ActiveSheet.Range("A1").Height    'return to cell size
        End If
    End With
End Sub

One or two images is no problem, the work comes when you have hundreds of images to do this to.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,327
Members
452,635
Latest member
laura12345

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
Back
Top