Help Centering Image VBA

[Kristie390]

Please help.
I currently am using the below to insert a picture but it is now going top left. I would like to have this resized to auto fit in the cell with the row height 125.
Can someone please help me here? I have researched a few places online and keep getting an error. VBA newbie here..




With Range(BCell)


Set myPict = ActiveSheet.Pictures.Insert(PictureLoc)


.RowHeight = 125

myPict.Top = .Top
myPict.Left = .Left
myPict.Placement = xlMoveAndSize


myPict.Height = 115


End With

 

[Kristie390]

The way the code works now seems to be fine, but it is not doing what it intends to do from what I can see.
The image should be auto-fitting inside of the B cell, correct?

 

[shg]

I don't know what "auto-fitting" means. Should it be the same height and width as the cell? Isn't that likely to stretch the picture one way or the other?

 

[Kristie390]

In the code I had previously, the rows were set to a height of 125 and the images were set to a height of 115 I believe. It was resizing them and i was not seeing any issues with the pictures being stretched. Maybe it was something in the code i was overlooking that was put in there.
The issue I had was that the code set to top left justify the image.
Is there something I can use besides this to center the image and then I can go back to the row height and image height I had before ? It sounds like it could be easier? I am not sure.

.RowHeight = 125

myPict.Top = .Top
myPict.Left = .Left
myPict.Placement = xlMoveAndSize


myPict.Height = 115

 

[shg]

Sub Kristie()
  ' inserts the picture files listed in col A into the workbook,
  ' sizes then to the same height and width as the cell in col B,
  ' and centers them in col B

  Const sPath       As String = "S:\Images\Casio"
  'Const sPath       As String = "C:\Users\shg\Pictures\shg\"
  Dim cell          As Range
  Dim sFile         As String
  Dim oPic          As Picture

  For Each cell In Range("A2", Cells(Rows.Count, "A").End(xlUp))
    sFile = sPath & cell.Text & ".jpg"
    If Len(Dir(sFile)) Then
      Set oPic = ActiveSheet.Pictures.Insert(sFile)

      With cell.Offset(, 1)
        oPic.Height = .Height
        oPic.Width = .Width
        oPic.Top = .Top + .Height / 2 - oPic.Height / 2
        oPic.Left = .Left + .Width / 2 - oPic.Width / 2
      End With
    Else
      cell.Select
      MsgBox sFile & " not found"
    End If
  Next cell
End Sub

 

[Kristie390]

Thank you for the revision. I do see that these are for the most part not fitting inside of the cells . They overlap . Shouldnt they be the same size as the cell in B?

 

[shg]

Sub Kristie()
  ' inserts the picture files listed in col A into the workbook,
  ' sizes them to fit the position, height, and width of the
  ' adjacent cell in col B

  Const sPath       As String = "S:\Images\Casio"
  'Const sPath       As String = "C:\Users\shg\Pictures\shg"
  Dim cell          As Range
  Dim sFile         As String
  Dim oPic          As Picture

  For Each cell In Range("A2", Cells(Rows.Count, "A").End(xlUp))
    sFile = sPath & cell.Text & ".jpg"
    If Len(Dir(sFile)) Then
      Set oPic = ActiveSheet.Pictures.Insert(sFile)
      oPic.ShapeRange.LockAspectRatio = msoFalse

      With cell.Offset(, 1)
        oPic.Height = .Height
        oPic.Width = .Width
        
        oPic.Top = .Top + .Height / 2 - oPic.Height / 2
        oPic.Left = .Left + .Width / 2 - oPic.Width / 2
      End With
    Else
      cell.Select
      MsgBox sFile & " not found"
    End If
  Next cell
End Sub

 

[shg]

If you want no overlap of the cell edges, it's possible to

o fit the picture to the cell height and allow it to be narrower than the width, or

o fit it to the cell width and allow it to be shorter than the height.

Right now, it stretches to fit,

 

[Kristie390]

Ok, great, yes- can I please ask to fit the picture to the cell height and allow it to be narrower than the width

 

[shg]

That's not two choices, it's one. If you always scale it to the height, it may overlap the width, and vice versa. The option from what I posted is to scale it upward until it meets the first dimension.

 

[Kristie390]

Ok, thats fine . Lets give that a try
I thought it was 2, it said OR