Picture inserting,resizing and rotating with Macro depending on height and width

Strifly · #1 10-31-2017, 09:29 AM

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.

gmaxey · #2 11-01-2017, 06:36 AM

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

Strifly · #3 11-05-2017, 03:18 AM

Hey Greg!

It Works !!! exactly what I was after !!
Thank you very much !

Eli.

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