#1
|
|||
|
|||
(.left property) and (LockAspectRatio) don't work
Hi,
In need help … I have macro to insert picture into a sheet: Code:
Sub Gen_InsertPicture() 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.LockAspectRatio = msoTrue '.Height = Selection.Offset(Selection.Rows.Count, 0).Top - Selection.Top .Width = Selection.Offset(0, Selection.Columns.Count).Left - Selection.Left .Top = Selection.Top .Left = Selection.Offset(0, Selection.Columns.Count).Left - .Width .Placement = xlMoveAndSize End With Set pic = Nothing If ActiveSheet.CodeName = "Sheet9" Then With Range("DrwgArea").Interior .Pattern = xlNone End With End If End Sub the file is Attached |
#2
|
|||
|
|||
Hi
It hasn't got anything to do with L-R/R-L feature. The picture in its size of origin probably just doesn't fit on the sheet, therefore the ratioaspects get lost. Enable the columns beyond AB and most probably it will do (otherwise you may enable a couple of rows as well). The other option is, to insert the picture on another sheet, arrange the seize there according to your selection, and copy it to the space desired. |
#3
|
||||
|
||||
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
|||
|
|||
macropod, YOUR ADJUSTMENT WORKED PERFECTLY
macropod, you're a genius
IT WORKS PERFECTLY. JUST BY YOUR ADJUSTMENT THANKS AGAIN... |
|
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 |