Keyser_Soeze
New Member
- Joined
- Oct 30, 2020
- Messages
- 13
- Office Version
- 365
- Platform
- 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
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