Changing Selections to Ranges

C

Captain_Nemo

Gang -
From many posts here I understand that it is better to use ranges over
selections when manipulating text. Unfortunately I can't figure out how
to change what the Macro Recorder hath wrought to accomplish that end.
Could someone please look at this code and advise? It is part of a macro
that puts a text box containing a 2x2 table dead center on the first
page and then copies that same text box to every other page. The text
box takes the place of a manual stamp.

Thanks in advance.
....best, Capt N.

---------
ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
lX_Center - lX_Offset, lY_Center - lY_Offset, 2 * lX_Offset, 2 *
lY_Offset).Select

With Selection.ShapeRange
.TextFrame.TextRange.Select
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
.TextFrame.MarginLeft = InchesToPoints(sCellPaddingLeft)
.TextFrame.MarginTop = InchesToPoints(sCellPaddingTop)
.LockAnchor = True
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Name = "mrttextbox" & i
.ZOrder msoBringToFront
End With

Selection.Collapse
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2,
NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed

With Selection.Tables(1)
.Columns.PreferredWidth = InchesToPoints(1.5)
.TopPadding = InchesToPoints(sCellPaddingTop)
.LeftPadding = InchesToPoints(sCellPaddingLeft)
.RightPadding = InchesToPoints(sCellPaddingRight)
.BottomPadding = InchesToPoints(sCellPaddingBottom)
.Spacing = 0
.AllowPageBreaks = True
.AllowAutoFit = True
End With

Selection.Tables(1).Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorRed
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
End With


Selection.TypeText Text:=strResult1
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:=strResult2
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Sheet #"
Selection.MoveRight Unit:=wdCell

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:=
_
"PAGE ", PreserveFormatting:=True
Selection.TypeText Text:=" of " & iNumPages


With Selection.Tables(1)
.Shading.BackgroundPatternColor = wdColorGray10
.Borders.OutsideLineStyle = wdLineStyleThinThickThinSmallGap
.Borders.InsideLineStyle = wdLineStyleNone
.Borders(wdBorderBottom).Color = wdColorRed
.Borders(wdBorderTop).Color = wdColorRed
.Borders(wdBorderLeft).Color = wdColorRed
.Borders(wdBorderRight).Color = wdColorRed
.Borders.Shadow = False
End With

Selection.ShapeRange("mrttextbox1").Select
lTextBoxTop = Selection.ShapeRange.Top
lTextBoxLeft = Selection.ShapeRange.Left
Selection.Copy

For i = 2 To iNumPages
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=i
Selection.Paste
Selection.ShapeRange.Top = lTextBoxTop
Selection.ShapeRange.Left = lTextBoxLeft
Selection.ShapeRange.Name = "mrttextbox" & i
Selection.ShapeRange.ZOrder msoBringToFront
Next i

--
Email to (e-mail address removed) (yes, you can so figure it out) ;-]

Scream and shout and jump for joy! I was here before Kilroy!

Sorry to spoil your little joke. I was here but my computer broke. ---Kilroy
 
J

Jezebel

Dim pShape as Word.Shape
Dim pTable as Word.Table

set pShape = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
_
lX_Center - lX_Offset, lY_Center - lY_Offset, 2 *
lX_Offset, 2 *
lY_Offset)

etc






Gang -
From many posts here I understand that it is better to use ranges over
selections when manipulating text. Unfortunately I can't figure out how
to change what the Macro Recorder hath wrought to accomplish that end.
Could someone please look at this code and advise? It is part of a macro
that puts a text box containing a 2x2 table dead center on the first
page and then copies that same text box to every other page. The text
box takes the place of a manual stamp.

Thanks in advance.
...best, Capt N.

---------
ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
lX_Center - lX_Offset, lY_Center - lY_Offset, 2 * lX_Offset, 2 *
lY_Offset).Select

With Selection.ShapeRange
.TextFrame.TextRange.Select
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
.TextFrame.MarginLeft = InchesToPoints(sCellPaddingLeft)
.TextFrame.MarginTop = InchesToPoints(sCellPaddingTop)
.LockAnchor = True
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Name = "mrttextbox" & i
.ZOrder msoBringToFront
End With

Selection.Collapse
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2,
NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed

With Selection.Tables(1)
.Columns.PreferredWidth = InchesToPoints(1.5)
.TopPadding = InchesToPoints(sCellPaddingTop)
.LeftPadding = InchesToPoints(sCellPaddingLeft)
.RightPadding = InchesToPoints(sCellPaddingRight)
.BottomPadding = InchesToPoints(sCellPaddingBottom)
.Spacing = 0
.AllowPageBreaks = True
.AllowAutoFit = True
End With

Selection.Tables(1).Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorRed
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
End With


Selection.TypeText Text:=strResult1
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:=strResult2
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Sheet #"
Selection.MoveRight Unit:=wdCell

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:=
_
"PAGE ", PreserveFormatting:=True
Selection.TypeText Text:=" of " & iNumPages


With Selection.Tables(1)
.Shading.BackgroundPatternColor = wdColorGray10
.Borders.OutsideLineStyle = wdLineStyleThinThickThinSmallGap
.Borders.InsideLineStyle = wdLineStyleNone
.Borders(wdBorderBottom).Color = wdColorRed
.Borders(wdBorderTop).Color = wdColorRed
.Borders(wdBorderLeft).Color = wdColorRed
.Borders(wdBorderRight).Color = wdColorRed
.Borders.Shadow = False
End With

Selection.ShapeRange("mrttextbox1").Select
lTextBoxTop = Selection.ShapeRange.Top
lTextBoxLeft = Selection.ShapeRange.Left
Selection.Copy

For i = 2 To iNumPages
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=i
Selection.Paste
Selection.ShapeRange.Top = lTextBoxTop
Selection.ShapeRange.Left = lTextBoxLeft
Selection.ShapeRange.Name = "mrttextbox" & i
Selection.ShapeRange.ZOrder msoBringToFront
Next i

--
Email to (e-mail address removed) (yes, you can so figure it out) ;-]

Scream and shout and jump for joy! I was here before Kilroy!

Sorry to spoil your little joke. I was here but my computer
Click to expand...
broke. ---Kilroy
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Loop until end 1
Select Text to End of Footnote 9
Multiple Tables 2
Need help modifying code 0
Text Overflow 4
Would like better understanding of how this macro works. 3
Macro to Select text from a point given to a specific word 2
Macro to fix header 0

Top