Get The Dimensions of an Imported Image

I was googling for a VBA code that allows me to get the dimension in "cm" of the imported image in the an Excel sheet. So the process I import the image and once imported it registers the dimensions Width & Height in a certain cell unit = cm. And if I move the image, the dimensions follow the image moving cells.

I found below links:
https://stackoverflow.com/questions/...age-dimensions
https://social.msdn.microsoft.com/Fo...e?forum=isvvba

Those links didn't work with me for the imported image in Excel plus it get info of a static file name while it should be variable.

Any help please.

Thank you for your questions, I meant insert instead of import. The insert picture in excel at the INSERT Tab.

The process is as following:
1- We'll insert images in Excel, now the images are saved and embedded within the excel thus the link and where it comes from isn't important. As we can delete the image folder but the image remains working should be.
2- After the insert automatically for example the dimensions are inserted in cells like in A10 = 120cm Width B10 = 120cm Height.
3- And if we move the image let's say from cells A-B-C to F-G-H the dimensions will move from A10 and B10 to F10 and G10


Hope this clarifies everything

The link below for the file that includes the pictures I'm referring to, what I'm trying is to retrieve the dimensions of those images in cells of the excel worksheet in CM. Any help please?

https://files.fm/u/t8fpwczb

Why "72 * 2.54" Does that refer as static measure. Please not images dimensions might differ from one another. I want to print the values into cells. Please advice me with a complete code, thank you!

Originally Posted by bakerman2

Remove the Calculate-event the try this one.

Private Sub Worksheet_Change(ByVal Target As Range)
    Const numpix = 37.7952755905511 'pixels per cm
    If Target.Address = "$P$3" Then
        Dim mypic As Picture
        Me.Pictures.Visible = False

        With Range("e2")
            For Each mypic In Me.Pictures
                If mypic.Name = .Text Then
                    mypic.Visible = True
                    mypic.Top = .Top
                    mypic.Left = .Left
                    Exit For
                End If
            Next mypic
        End With
        Dim wpicture As String, s As Double, y As Double
        With Sheet2
            wpicture = .Cells(Application.Match(Target.Value, .Columns(1), 0), 2)
        End With
        With Sheet1
            s = Round(.Shapes(wpicture).Height / numpix, 2)
            y = Round(.Shapes(wpicture).Width / numpix, 2)
        End With
    
        MsgBox "Picture dimensions are " & vbLf & vbLf & _
            "Height: " & s & " cm" & vbLf & vbLf & _
            "Width: " & y & " cm"
    End If
End Sub

Thank you I think it's working now but 2 things:

1- I need to print the values in cells rather a message box
2- When I compare the message box for example it says
Picture dimensions are:
Height: 8.99 cm
Width: 12.74cm

When double clicking on this pic and go to the format section /picture tools it's giving me height 11.99 cm and width 16.99cm. There are big difference why?

Originally Posted by Marc L

Hi !

Have look to CentimetersToPoints method …

Can you elaborate please

Originally Posted by webiscore

Can you elaborate please

To see in VBA inner help …

Private Sub Worksheet_Change(ByVal Target As Range)
    Const numpix = 37.7952755905511 'pixels per cm

        Dim mypic As Picture
        Me.Pictures.Visible = False

        With Range("e2")
            For Each mypic In Me.Pictures
                If mypic.Name = .Text Then
                    mypic.Visible = True
                    mypic.Top = .Top
                    mypic.Left = .Left
                    Exit For
                End If
            Next mypic
        End With
        Dim wpicture As String, s As Double, y As Double
        With Sheet2
            wpicture = .Cells(Application.Match(Target.Value, .Columns(1), 0), 2)
        End With
        With Sheet1
            s = Round(.Shapes(wpicture).Height / 72 * 2.54, 2)
            y = Round(.Shapes(wpicture).Width / 72 * 2.54, 2)
        End With
    
        MsgBox "Picture dimensions are " & vbLf & vbLf & _
            "Height: " & s & " cm" & vbLf & vbLf & _
            "Width: " & y & " cm"
            
            
        Range("Q5") = s & "cm"
        Range("Q6") = y & "cm"  /// BTW IT's not Printing Width Only the Height
End Sub

I'm trying the following code and thanks a lot to you now I'm getting the accurate size but it's keep giving me
Run-time error '13":
Type mismatch

wpicture = .Cells(Application.Match(Target.Value, .Columns(1), 0), 2)

I checked the cells are correct and there's no mismatch but why?

Range("Q6") = y & "cm" /// BTW IT's not Printing Width Only the Height

Thanks man I appreciate and really sorry.

But why when I use If Target.Address = "$P$3" Then it doesn't load the images and dimensions and once I comment it I get the info needed but the excel keeps looping and stops responding.

Originally Posted by bakerman2

Did you put the code in the worksheetmodule of Sheet1 ?

Replace P3 with the Range your Datavalidation is in.

Can't upload your file because it's too big.

This is the code and now working fine thanks.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim mypic As Picture

   If Target.Address = "$A$4" Then
        Me.Pictures.Visible = False
        With Range("e2")
            For Each mypic In Me.Pictures
                If mypic.Name = .Text Then
                    mypic.Visible = True
                    mypic.Top = .Top
                    mypic.Left = .Left
                    Exit For
                End If
            Next mypic
        End With

        With ActiveSheet
            s = Round(.Shapes(.Range("e2").Value).Height / 72 * 2.54, 2) & "cm"
            y = Round(.Shapes(.Range("e2").Value).Width / 72 * 2.54, 2) & "cm"
        
        
        MsgBox "Picture dimensions are " & vbLf & vbLf & _
            "Height: " & s & vbLf & vbLf & _
            "Width: " & y
            
            .Range("Q5") = s
            .Range("Q6") = y
        
        End With
    End If
End Sub

Please can you advise me how to auto update the values if I'm resizing the image without going back and forth or closing the excel sheet.

Thank you so much!

Please use https://files.fm

Didn't get your point

Thank you I have managed that but now i'm trying to autoupdate the values if the image was resized

Originally Posted by bakerman2

A shape only knows the click event so resizing a shape won't activate any code.

The only workaround I can think of is putting an Active-X label on the worksheet so you can use the mouseover- event to recalculate the dimensions.

You could place that label in a convenient place, remove the caption and set backstyle to transparent so it's invisible but present.

Thanks a lot for the information and so much appreciated for your support. Can you please elaborate and show me an example i'm a newbie