|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Picture inserting,resizing and rotating with Macro depending on height and width
Hello everyone!
I'm new here and wondered if I can get some help I'm unfamiliar with VBA but some-what succeeded to work with found codes in different forums while building a database in MS Access a few years ago... Now I'm stuck with a pic-by-pic assembly manual that I need to prepare for work... Shortly, I need to insert a picture into a dedicated space (in my case a cell in a table) while resizing it's height to 1.7" (4.318cm) and maintaining the aspect ratio. I found the code I need but only understood the next problem only after printing, I need to determine with code which is longer height of the original picture or width and rotating the picture 90 degrees if height is longer than width, only then resizing it's height and maintaining the aspect ration to fit the cell in my table. The code I found and played with a bit is this : Sub PicSize() ' ' PicSize Macro ' ' Dim oDialog As Dialog Dim strFile As String Dim oImage As Object Dim oRng As Range Set oDialog = Dialogs(wdDialogInsertPicture) With oDialog .Display If .Name <> "" Then strFile = .Name End If End With If IlShp.Width < IlShp.Height Then shp.IncrementRotation 90 End If Set oImage = Selection.InlineShapes.AddPicture(strFile) With oImage .LockAspectRatio = msoTrue .Height = CentimetersToPoints(4.318) Set oRng = oImage.Range End With Set oDialog = Nothing Set oImage = Nothing Set oRng = Nothing End Sub Can somebody help? Thanks, Strifly. |
#2
|
|||
|
|||
Not exactly sure what you are after but maybe:
Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 11/1/2017 Dim strFile As String Dim oILS As InlineShape, oShp As Shape Dim bRotate As Boolean bRotate = False With Dialogs(wdDialogInsertPicture) .Display If .Name <> "" Then strFile = .Name End With If strFile <> vbNullString Then Set oILS = Selection.InlineShapes.AddPicture(strFile) With oILS If .Width < .Height Then Set oShp = .ConvertToShape oShp.IncrementRotation 90 bRotate = True End If End With If bRotate Then Set oILS = oShp.ConvertToInlineShape With oILS .LockAspectRatio = msoTrue If bRotate Then .Width = CentimetersToPoints(4.318) Else .Height = CentimetersToPoints(4.318) End If MsgBox .Height & " " & .Width End With End If Set oILS = Nothing: Set oShp = Nothing End Sub |
#3
|
|||
|
|||
Hey Greg!
It Works !!! exactly what I was after !! Thank you very much ! Eli. |
Tags |
height, picture, width |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Help - Run-time error 91 - VBA for inserting and formatting text depending on style | mtrborges | Word VBA | 2 | 02-08-2015 11:35 PM |
Lost photo content after rotating photos using MS Picture Manager | jefflyon | Office | 1 | 08-22-2014 11:57 PM |
Height and Width blank - Excel Chart in Powerpoint | Metronome | PowerPoint | 1 | 04-06-2012 06:20 AM |
Rotating a picture in a picture box | Cath5000 | PowerPoint | 1 | 01-18-2012 03:04 PM |
Word is inserting bold page-width lines without permission! | kozureokami | Word | 6 | 05-22-2011 02:59 PM |