needhelp9009
New Member
- Joined
- Mar 30, 2021
- Messages
- 10
- Office Version
- 365
- Platform
- Windows
I am using a macros to insert pictures into the active cell.
i.e. click B3, run macros and choose picture from the file. this works well in row 3. However, as I continue adding pictures going down the rows. example B90, the picture appears shifted out of the box..
This is my code:
i.e. click B3, run macros and choose picture from the file. this works well in row 3. However, as I continue adding pictures going down the rows. example B90, the picture appears shifted out of the box..
This is my code:
VBA Code:
Sub test()
Dim myPic As String, Pic As Shape, Rng As Range
Dim a As Double, shp As Shape, x As Long, j As Long, jj As Long
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 7) = "Picture" Then x = x + 1
Next shp
myPic = Application.GetOpenFilename( _
FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
Title:="Please select an image...")
If myPic = "False" Then Exit Sub
Set Pic = Application.ActiveSheet.Shapes.AddPicture(myPic, False, True, 0, 0, -1, -1)
j = ActiveCell.Row
jj = ActiveCell.Column
With Pic
.Name = "Picture" & x + 1
.LockAspectRatio = False
.Left = Cells(j, jj).Left
.Top = Cells(j, jj).Top - (j * 1 / 100)
.Height = ActiveCell.Height
.Width = ActiveCell.Width
End With
End Sub
Last edited by a moderator: