Photos

[Mary]

Ihave created a procedure (based on a previous post) to
insert photographs into a table cell.

I have a problem and don't know whether it can be solved
and was wondering if anyone had any advice.

When choosing to insert a landscape photo the size of the
photo work wonderfully, however, when I insert a portrait
photo I want the ratio to be set by the height
measurement. The width always seems to take priority -
is there any way around this.

Please see my code below, many thanks:-

Dim Myrange As Range
Dim MyWidth As Long
Const FixWidth As Long = 147.4

If Selection.Information(wdWithInTable) Then
With Dialogs(wdDialogInsertPicture)
If .Show Then
Set Myrange = Selection.Cells(1).Range
If Myrange.InlineShapes.Count > 0 Then
With Myrange.InlineShapes(1)
.LockAspectRatio = msoTrue
.Height = 138.5
MyWidth = 147.4
.Width = 147.4
'.Height = .Height * (FixWidth / MyWidth)
End With
Else
With Myrange.ShapeRange
.LockAspectRatio = msoTrue
.Width = 147.4
.Left = wdShapeCenter
.WrapFormat.Type = wdWrapInline
.WrapFormat.Side = wdWrapBoth
.LockAnchor = False
.IncrementLeft 1#
.IncrementTop 73#
End With
End If
End If
End With
End If

 

[Helmut Weber]

Hi Mary,
I've heard of this bug sometimes,
but haven't heard of a solution except
of calculating the ratio after insertion
and adjusting the measurements afterwards.
Which you seem to have tried, but I wonder
if given a new width the new height should
be .Height * (FixWidth / MyWidth).
Admittedly, I don't get all you have coded.
I' doing it this way:

Sub Test288()
Dim sWdtOld As Single ' Width Old
Dim sHgtOld As Single ' Height Old
Dim sWdtNew As Single ' Width New
Dim sHgtNew As Single ' Height New
Dim sRat As Single ' Ratio
With Selection.InlineShapes(1)
sWdtOld = PointsToCentimeters(.Width)
sHgtOld = PointsToCentimeters(.Height)
sRat = sHgtOld / sWdtOld
sWdtNew = 2 ' here the new width is 2 cm !!!
sHgtNew = sWdtNew * sRat
.Width = CentimetersToPoints(sWdtNew)
.Height = CentimetersToPoints(sHgtNew)
End With
End Sub

Greetings from Bavaria, Germany
Helmut Weber, MVP WordVBA
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000