S
sysdrk
I have a bunch of .htm files created by Word with embedded pictures
(photos - inserted as picture from file). These photos are set to
square wrap and left justified. I'm working on a macro that will let
me add a comment below each photo and leave it in a square wrap, left
justified in the same original position.
I have this macro mostly completed but a couple things don't work quite
right so I would be interested if someone has any insight.
First, I created a transparent text box and aligned it so that it was
centered just under the picture. This works fine but as soon as I
group the picture and text box, the text box gets shifted from just
below the photo to the center of the picture, messing up my careful
alignment.
Next, the act of grouping the picture and text box also undoes the
square wrap of the original photo. So I was hoping that I could
restore the original setup by re-setting a square wrap along with the
top and left values of the photo/text group to that of the original
photo. Unfortunately, while this almost gets it right, it appears that
this shifts the final result to the beginning of the paragraph whereas
the original picture was inserted somewhere inside the paragraph.
Attached is the script using Word 2003.
Denis
---------------------------------------------------------------
Sub AddText()
' Picture must already be selected (add error checking here)
Set pict = Selection
' Save picture name, height, and top and left positions
With pict.ShapeRange
pictname = .Name
pictht = .Height
pictrvp = .RelativeVerticalPosition
picttop = .Top
pictrhp = .RelativeHorizontalPosition
pictleft = .Left
End With
' Create text box the width of picture, set fill and outline to
transparent
ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
197.6, 368.35, pict.ShapeRange.Width, 10).Select
Set tbox = Selection
With Selection.ShapeRange
.Fill.Visible = msoFalse
.Fill.Visible = msoFalse
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoFalse
.Height = 26#
End With
' Insert text in bold format in text box
tbox.Font.Bold = wdToggle
tbox.TypeText Text:="Text"
tbox.ParagraphFormat.Alignment = wdAlignParagraphCenter
' Make ShapeRange out of picture and text box, align text box with
center
' of picture, shift text box down to just below picture, then group
vertshift = (pictht + tbox.ShapeRange.Height) / 2
ActiveDocument.Shapes.Range(Array(pictname,
tbox.ShapeRange.Name)).Select
Set pictext = Selection
pictext.ShapeRange.Align msoAlignLefts, False
pictext.ShapeRange.Align msoAlignMiddles, False
tbox.ShapeRange.IncrementTop vertshift
---> pictext.ShapeRange.Group.Select <---- this messes up alignment
' Set to square wrap with previous position of picture
With Selection.ShapeRange
.RelativeVerticalPosition = pictrvp
.Top = picttop
.RelativeHorizontalPosition = pictrhp
.Left = pictleft
.LockAnchor = False
.LayoutInCell = True
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapBoth
.WrapFormat.DistanceTop = InchesToPoints(0)
.WrapFormat.DistanceBottom = InchesToPoints(0)
.WrapFormat.DistanceLeft = InchesToPoints(0.13)
.WrapFormat.DistanceRight = InchesToPoints(0.13)
.WrapFormat.Type = wdWrapSquare
.TextFrame.AutoSize = False
End With
End Sub
(photos - inserted as picture from file). These photos are set to
square wrap and left justified. I'm working on a macro that will let
me add a comment below each photo and leave it in a square wrap, left
justified in the same original position.
I have this macro mostly completed but a couple things don't work quite
right so I would be interested if someone has any insight.
First, I created a transparent text box and aligned it so that it was
centered just under the picture. This works fine but as soon as I
group the picture and text box, the text box gets shifted from just
below the photo to the center of the picture, messing up my careful
alignment.
Next, the act of grouping the picture and text box also undoes the
square wrap of the original photo. So I was hoping that I could
restore the original setup by re-setting a square wrap along with the
top and left values of the photo/text group to that of the original
photo. Unfortunately, while this almost gets it right, it appears that
this shifts the final result to the beginning of the paragraph whereas
the original picture was inserted somewhere inside the paragraph.
Attached is the script using Word 2003.
Denis
---------------------------------------------------------------
Sub AddText()
' Picture must already be selected (add error checking here)
Set pict = Selection
' Save picture name, height, and top and left positions
With pict.ShapeRange
pictname = .Name
pictht = .Height
pictrvp = .RelativeVerticalPosition
picttop = .Top
pictrhp = .RelativeHorizontalPosition
pictleft = .Left
End With
' Create text box the width of picture, set fill and outline to
transparent
ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
197.6, 368.35, pict.ShapeRange.Width, 10).Select
Set tbox = Selection
With Selection.ShapeRange
.Fill.Visible = msoFalse
.Fill.Visible = msoFalse
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoFalse
.Height = 26#
End With
' Insert text in bold format in text box
tbox.Font.Bold = wdToggle
tbox.TypeText Text:="Text"
tbox.ParagraphFormat.Alignment = wdAlignParagraphCenter
' Make ShapeRange out of picture and text box, align text box with
center
' of picture, shift text box down to just below picture, then group
vertshift = (pictht + tbox.ShapeRange.Height) / 2
ActiveDocument.Shapes.Range(Array(pictname,
tbox.ShapeRange.Name)).Select
Set pictext = Selection
pictext.ShapeRange.Align msoAlignLefts, False
pictext.ShapeRange.Align msoAlignMiddles, False
tbox.ShapeRange.IncrementTop vertshift
---> pictext.ShapeRange.Group.Select <---- this messes up alignment
' Set to square wrap with previous position of picture
With Selection.ShapeRange
.RelativeVerticalPosition = pictrvp
.Top = picttop
.RelativeHorizontalPosition = pictrhp
.Left = pictleft
.LockAnchor = False
.LayoutInCell = True
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapBoth
.WrapFormat.DistanceTop = InchesToPoints(0)
.WrapFormat.DistanceBottom = InchesToPoints(0)
.WrapFormat.DistanceLeft = InchesToPoints(0.13)
.WrapFormat.DistanceRight = InchesToPoints(0.13)
.WrapFormat.Type = wdWrapSquare
.TextFrame.AutoSize = False
End With
End Sub