Help Centering Image VBA

Kristie390

New Member
Joined
Jul 23, 2018
Messages
24
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
 
Can you explain in clear words and sentences what you're tryin to do?

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

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
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
 
Upvote 0
Code:
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
 
Upvote 0
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.
 
Upvote 0
That code is correct as posted. Try again, copying into a clean (empty) module.
 
Upvote 0
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
344rwjm.jpg


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
 
Upvote 0
It's not connected to any events. Run the macro using Alt+F8.
 
Upvote 0
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?
 
Upvote 0
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.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,264
Members
448,558
Latest member
aivin

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