Adding Shape and Picture

[judgejustin]

Is there any way to Lock Aspect Ratio of a Shape Relevant to a Picture that is being added with the shape. Trying to merge the functions together some how. I want to define the largest boarders of the shape but maintain the aspect ratio at the same time and anywhere the ratio falls inside of those boarders are fine.

.Shapes.AddPicture, (relevant boarder area)

and

.LockAspectRatio, True

 

[judgejustin]

This finally seems to be working I have tested several pictures with various aspect ratios and it is looking great. I am putting the final code below in case it can help anyone else.

THANK YOU!!!!

Sub Button1_Click()
Dim myFiles, e
Dim p As Object
      myFiles = Application.GetOpenFilename(, , , , True)
      If Not IsArray(myFiles) Then Exit Sub
      For Each e In myFiles
       With ActiveSheet
          .Protect "Password", DrawingObjects:=False, Contents:=True, Scenarios:=True
          Set p = ActiveSheet.Shapes.AddPicture(e, False, True, Range("C4:C58").Left, Range("C4:L58").Top, -1, -1)
          
If p.Width / Range("C4:L58").Width > p.Height / Range("C4:L58").Height Then

p.Width = Range("C4:L58").Width
Else
p.Height = Range("C4:L58").Height

End If
              End With
      Next
  End Sub

 

[yky]

You're welcome.

 

[judgejustin]

Out of nothing more than curiosity and future use is there also a way to center these pictures with in the cell ranges. I would assume you would add something to the bottom part where it sets the p.width or p.height.
Just wondering though if it is complicated no worries.

 

[yky]

To center the picture, set the following:

p.Left =[COLOR=#333333]Range("C4:L58").Left + ([/COLOR][COLOR=#333333]Range("C4:L58").Width-p.Width)/2

p.Top = [/COLOR][COLOR=#333333]Range("C4:L58").Top[/COLOR][COLOR=#333333] + ([/COLOR][COLOR=#333333]Range("C4:L58").Height - p.Height)/2[/COLOR]

 

[judgejustin]

SWEEEEETTT.....
Thanks Again