images

Sub InsertPictures()
 
    Dim Pict() As Variant
    Dim ImgFileFormat As String
    Dim PictCell As Range
    Dim Ans As Integer
    Dim newPicture As Shape
    Dim lRow As Long, lLoop As Long
    Dim lTop As Long
    Dim sShape As Shape
    Dim sUserInput As String
    Const PointsPerCm As Double = 28.3464567
     
    ActiveSheet.Protect False, False, False, False, False
     
    ‘ Prompt user for picture file(s)
    Pict = Application.GetOpenFilename(ImgFileFormat, MultiSelect:=True)
     
    If Not IsArray(Pict) Then
        MsgBox “No files selected.”, vbCritical
        Exit Sub
    End If
     
    ‘ Prompt user for image width (in cm)
    sUserImageHeight = InputBox(“Enter image height (in cm):”, “”)
     
    If Not (Len(sUserImageHeight) > 0 And IsNumeric(sUserImageHeight)) Then
        MsgBox “Invalid input, aborting.”, vbCritical
        Exit Sub
    End If
     
    lRow = 2
    For lLoop = LBound(Pict) To UBound(Pict)
        lTop = Cells(lRow, “A”).Top
        Set sShape = ActiveSheet.Shapes.AddPicture(Pict(lLoop), msoFalse, msoCTrue, Cells(2, 2).Left, lTop, 50, 50)
        With sShape
        .LockAspectRatio = msoTrue
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
        .Height = sUserImageHeight * PointsPerCm
        End With
        lRow = lRow + 1
    Next lLoop
 
End Sub