Insert picture into Excel and keep aspect ratio without exceeding dimensions with VBA -

i exporting data access database excel report, , part of needs included in report pictures corresponding data. pictures stored in shared file , inserted excel file so:

dim p object dim xlapp excel.application dim wb workbook  set xlapp = new excel.application  xlapp      .visible = false      .displayalerts = false end  set wb = xlapp.workbooks.open(filepath, , true)  set p = xlapp.sheets(1).pictures.insert(picpath) 'insert picture p      .shaperange           .lockaspectratio = msofalse           .width = 375           .height = 260      end      .left = xlapp.sheets(1).cells(y, x).left      .top = xlapp.sheets(1).cells(y, x).top      .placement = 1      .printobject = true end  wb.saveas filename:= newname, createbackup:=false  wb.close savechanges:=true  xlapp.displayalerts = true xlapp.application.quit 

the issue having can't seem able keep aspect ratio of pictures , make sure @ same time don't exceed bounds of space supposed fit in excel form. pictures screenshots there large amount of variability in shape , size.

basically want effect of grabbing corner of picture , expanding until touches either left or bottom edge of range supposed placed in.

this maximize size of image space without distorting it.

basically want effect of grabbing corner of picture , expanding until touches either left or bottom edge of range supposed placed in.

then must first find size of range (width , height) , find of picture's width , height, expanded, touches these boundaries first, set lockaspectratio = true , either set width, or height or set both stretched according aspect ratio.

the following scales picture available space (adapted code):

sub pictest()      dim p object     dim wb workbook     dim l, r, t, b     dim w, h        ' width , height of range fit picture     dim aspect      ' aspect ratio of inserted picture      l = 2: r = 4    ' co-ordinates of top-left cell     t = 2: b = 8    ' co-ordinates of bottom-right cell      set wb = activeworkbook      set p = activeworkbook.sheets(1).pictures.insert(picpath) 'insert picture     p          .shaperange               .lockaspectratio = msotrue    ' lock aspect ratio (do not distort picture)               aspect = .width / .height     ' calculate aspect ratio of picture               .left = cells(t, l).left      ' left placement of picture               .top = cells(t, l).top        ' top left placement of picture          end          w = cells(b, r).left + cells(b, r).width - cells(t, l).left    ' width of cell range          h = cells(b, r).top + cells(b, r).height - cells(t, l).top     ' height of cell range          if (w / h < aspect)             .shaperange.width = w           ' scale picture available width          else             .shaperange.height = h          ' scale picture available height          end if          .placement = 1     end  end sub