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

 

[shg]

Can you explain in clear words and sentences what you're tryin to do?

Look in column A, .... and do what?

 

[Kristie390]

Can you explain in clear words and sentences what you're tryin to do?

Look in column A, .... and do what?

Ok, I am sorry
I have a spreadsheet where the sku is in column A, and when the workbook opens, I want the images to be pulled from a shared drive and populated in B cells to fit in side the cell - which is defined by the height in the data.


So far it does work but not until you click on each sku, then the image will appear. Also, the image is top left justified.
I am looking for the image to be centered and fit inside the cell in B according to the sku in A.


Please let me know if I can clarify any other issues. Sorry for the hazy explanation

 

[shg]

Sub Kristie()
  ' inserts the picture files listed in col A into the workbook, 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("A:A").SpecialCells(xlCellTypeConstants, xlTextValues)
    sFile = sPath & cell.Text & ".jpg"
    If Len(Dir(sFile)) Then
      Set oPic = ActiveSheet.Pictures.Insert(sFile)
      
      With cell.Offset(, 1)
        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!

I am getting a compile error.
Block if without end if

If I add in another end IF, I get the compile error that says for without next.

 

[shg]

That code is correct as posted. Try again, copying into a clean (empty) module.

 

[Kristie390]

Yes, I just copied the spreadsheet that I had with the skus in the A column and then copied your code and put in the code.Nothing happens when I open the spreadsheet now and nothing happens when I click on the skus

Sub Kristie()
' inserts the picture files listed in col A into the workbook, and centers them in col B

Const sPath As String = "S:\Images\Bulova"
'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("A:A").SpecialCells(xlCellTypeConstants, xlTextValues)
sFile = sPath & cell.Text & ".jpg"
If Len(Dir(sFile)) Then
Set oPic = ActiveSheet.Pictures.Insert(sFile)

With cell.Offset(, 1)
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]

It's not connected to any events. Run the macro using Alt+F8.

 

[Kristie390]

Fantastic! Thank you!
Now that makes sense. How can I have it run as you open the page and how can we get it to skip the header that says SKU?

 

[Kristie390]

Also, it is not resizing the images. They are all full size & Overlapping each other

 

[shg]

Words and sentences, Kristie: What do you want the code to do?

Also, if the code runs every time the sheet is activated. pictures are going to stack up up on top of each other.