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

 

[yky]

See if this works:

          Set p = ActiveSheet.Shapes.AddPicture(e, False, True, Range("C4:L58").Left, Range("C4:L58").Top, -1, -1)

 

[judgejustin]

This gives the same results as what I had gotten before. There are no errors but the pictures get huge. They go to like Column AV and down to Row 168. I am not understanding why they don't stay within the range that is set. It looks like it should work.

 

[yky]

Is this line still there?

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

 

[judgejustin]

yes that line is in there

 

[judgejustin]

Here is the code I got to work the closest to what I need. However, it sets the last line as the parameter in this case it maintains aspect ratio but always goes to the maximum height and over extends the range of the width. I need it to maintain the aspect ratio but stay with in the confines of both the height and width ranges.

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").Left, Range("C4:L4").Top, -1, -1)
          p.Width = Range("C4:L58").Width
          p.Height = Range("C4:L58").Height
          
          
          

              End With
      Next

  End Sub

 

[yky]

You either set the width or the height, not both. If your picture is portray type, set the height to range height. Otherwise, set the width to range width.

 

[judgejustin]

The problem I am running into is that different users have varying sizes and may be either portrait or landscape. So I need it to always retain that aspect but only fall into a certain range of cells. The size of the picture inside those cells doesn't matter just that it falls inside of them and retains the original aspect ratio.
I am beginning to think there are just to many variables and this may be beyond the capabilities of a macro to perform. Would you agree with this assumption?

 

[yky]

No. Macro can handle that. You compare the ratio of p.width:range.width with p.height:range.height and see which one is larger. You then set the ratio of the larger one to 1. For example, you have the following:

p.width = 660
p.height=450
range.widht=240
range.height=180

p.width:range.width= 660:240=2.75
p.height:range.height=450:180=2.5

You set p.width to 240. P.height will be 163 (set by Excel).

Pseudo code is like this:

If p.width/range.width > p.height/range.height then

p.width = range.width
Else
p.height=range.height

End If

 

[judgejustin]

I'm not sure where to set the maximum height and width in the following code. Also when I run it I get a message that object doesn't support this method on the line If p.Width / p.Range.Width > p.Height / p.Range.Height Then.
Where do I set the maximums?

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:L4").Top, -1, -1)


If p.Width / p.Range.Width > p.Height / p.Range.Height Then

p.Width = p.Range.Width
Else
p.Height = p.Range.Height

End If
              End With
      Next
  End Sub

 

[yky]

Not p.range.width, nor p.range.height. Use the range where you want to picture to be. You have Range("C4:L4"), Range("C4:L58"), etc. Try Range("C4:L58").width and height.