Determine picture height in VBA

[obryan25]

I have a macro to insert a photo using a formula path on an excel spreadsheet.

The photo path is in worksheet "SubPhotos" cell "AC2".
"AMCPic" is the name of the range where the photo is pasted (its six cells... C10:E11... which have an outer border).
The picture is named "MyAMCPicture1" once it is inserted.
The "Dim i As Integer" was taken from another macros that cycled though multiple pics... however, this macro only uses one photo...

Once the picture is inserted I change the width to 446.4 to fit the width of columns C:E. Once the pictures width is set, I would like to determine what the inserted picture's height is in order to use that info to set the row height (there are actually two rows... 9 and 10) so that the picture sits just within the border of the "AMCPic" range.

The macro I am using follows. The areas set off with apostrophes are what I have tried to determine what the picture height is but I have not been successful. I think I can get the row height part to work but I can't accomplish this without figuring out what the picture height is.

Can someone please help me determine the picture width in pixels and add code to use that with my row height.


Sub InsertAMCPic()
'
' InsertAMCPic Macro
'

Dim PageNo
Dim RangePrint As Range
Dim photo As Picture 'Added per a help forum at xtremevbtalk.com
Dim PhotoCopy As Object 'added 120214 to run the Offset function for PhotoID
Dim PhotoNum As Object
Dim PhotoRefOne As Object
'Dim imgSize(1) As Integer
'Dim wia As Object
Application.ScreenUpdating = False
Sheets("SubPhotos").Select
RemSaleNum = Range("ad24") 'Counts down # of photos
RemDelNum = Range("ad24") 'Counts down # of photos for delete
Set PhotoCopy = Range("AC2") 'this field includes complete photo path and name
Sheets("Site").Select
Set PhotoRefOne = Range("AMCPic") 'this is range of cells where this photo is inserted.
Dim i As Integer
For i = 1 To RemSaleNum 'Do

'PIC 1
'Sheets("Site").Select.Range("AMCPic").ClearContents 'added as test 4/12/23
Sheets("SubPhotos").Select
Set PhotoCopy = PhotoCopy.Offset(1, 0) 'changed this from PhotoID to PhotoCopy 120214
PhotoID = PhotoCopy
Sheets("Site").Select
PhotoRefOne.Select 'selects range of cells where photo is inserted
Set photo = ActiveSheet.Pictures.Insert(PhotoID)
With photo
On Error Resume Next
ActiveSheet.Shapes.Range(Array("MyAMCPicture1")).Delete
On Error GoTo 0
'Pic.Name = "picture"

'.ShapeRange.LockAspectRatio = msoFalse
'.Width = 447
'.ShapeRange.LockAspectRatio = msoTrue
End With
photo.Name = "MyAMCPicture" & i
RemSaleNum = RemSaleNum - 2
Set PhotoRefOne = PhotoRefOne.Offset(15, 0)
ActiveSheet.Shapes.Range(Array("MyAMCPicture1")).Select
Selection.ShapeRange.Width = 446.4
'ActiveSheet.Shapes.Range(Array("MyAMCPicture1")).Select
'"MyAMCPicture1" = wia.Height
'Range("AMCPic").Select
'Selection.RowHeight = wia.Height


If RemSaleNum = 0 Then GoTo 350
Next i 'Loop Until RemSaleNum = 0
GoTo 400
100 TopCount = "1" 'Identifies the last photo page was one photo only
Counter = Counter + 1
110 Count = Counter * 15
Set RangePrint = Range(Cells(1, 1), Cells(Count, 5))
300 For i = 1 To RemDelNum
ActiveSheet.Shapes("MyAMCPicture" & i).Delete
Next i
350 ActiveSheet.Shapes.Range(Array("MyAMCPicture1")).Select
Selection.ShapeRange.IncrementLeft 1.5
Selection.ShapeRange.IncrementTop 1.5
400 Sheets("Site").Select
Range("C9").Select
'
End Sub

 

[obryan25]

Good to hear you have it working for you.
The reason I don't use width like you do (446.4) is because it is written in stone, a.k.a. hardcoded.
If I want a different width or an adjustment, I need to change it in the code.
Using the Column widths, all I need to do is change the width of one column. Same goes for rows.
But, to each his own.
Thanks for the update and good luck.

Your suggestion on how to handle column width is probably far superior to what I did, however I only have a basic understanding of vba coding and when I dropped in what you suggested, I could not get it to work. I am guessing I either dropped it in the wrong spot or messed up the "changes as required". I will definitely keep this in mind. I have no immediate plans to "ever" change the width in this template, but I have used it for a long time and its always changing - so I am sure it will bite me (right now, I'd have to edit ten or 15 macros if the column width were to change) if I don't try to incorporate your more flexible solution. THANK YOU again for your help. Greatly appreciated!!!

 

[jolivanes]

If you want a border around a picture, you can do it this way.
Change this (as in Post #7)

With ActiveSheet.Shapes.AddPicture(path & Cells(3, 13).Value, False, True, Columns(3).Left, Rows("10").Top, -1, -1)
    .Name = Cells(4, 13).Value    '<---- Change as required

to this

With ActiveSheet.Shapes.AddPicture(path & Cells(2, 7).Value, False, True, Columns(3).Left, Rows("10").Top, -1, -1)
    .Line.Weight = 3    '<---- experiment with this value
    .Line.Visible = msoTrue
    .Name = Cells(3, 7).Value    '<---- Change as required

No borders around the cells required.