(.left property) and (LockAspectRatio) don't work

macropod · #3 06-12-2014, 10:45 PM

Try:

Code:

Sub Gen_InsertPicture()
Application.ScreenUpdating = False
Dim sPicture As String, pic As Picture
FilterPics = "All Pictures, *.gif;*.jpg;*.jpeg;*.jpe;*.bmp;*.png;*.tif"
sPicture = Application.GetOpenFilename(FilterPics, , "select picture")
If sPicture = "False" Then Exit Sub
Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic.ShapeRange
  .ScaleWidth 0.01, True, msoScaleFromTopLeft
  .ScaleHeight 0.01, True, msoScaleFromTopLeft
  .LockAspectRatio = msoTrue
  .Height = Selection.Offset(Selection.Rows.Count, 0).Top - Selection.Top
  If .Width > Selection.Offset(0, Selection.Columns.Count).Left - Selection.Left Then
    .Width = Selection.Offset(0, Selection.Columns.Count).Left - Selection.Left
  End If
  .Top = Selection.Top
  .Left = Selection.Offset(0, Selection.Columns.Count).Left - .Width
End With
pic.Placement = xlMoveAndSize
Set pic = Nothing
If ActiveSheet.CodeName = "Sheet9" Then
    With Range("DrwgArea").Interior
        .Pattern = xlNone
    End With
End If
Application.ScreenUpdating = True
End Sub

Note that the original scaling gets restored by setting it to 1% of the original size (you may be able to start of with something much larger - I don't know what your picture sizes are) before adjusting it to the cell size. Also, after adjusting the height, the width only gets re-adjusted if it's still greater than the cell width.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Converting a left to right doc to a right to left	seli	Word	3	04-23-2012 11:39 PM
Link Watermark to custom property	kerend	Word	0	04-08-2012 05:03 AM
Left arrow won't work on Word	LaBecs	Word	2	09-26-2011 09:27 AM
Access to the property of the current table	b0x4it	Word VBA	2	05-26-2011 06:25 AM
set icon for user property	nav1982	Outlook	0	11-11-2009 05:40 AM