![]() |
|
#10
|
||||
|
||||
|
In that case, try:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim strTTxt As String, strRef As String, Rng As Range, Fld As Field, Tbl As Table
strTTxt = Trim(InputBox("Top Line Text?", ""))
strRef = Trim(InputBox("Reference?", ""))
With ActiveDocument
.ActiveWindow.View.ShowFieldCodes = False
With .PageSetup
.TopMargin = CentimetersToPoints(5)
.BottomMargin = CentimetersToPoints(3)
.LeftMargin = CentimetersToPoints(2.31)
.RightMargin = CentimetersToPoints(2.31)
.HeaderDistance = CentimetersToPoints(2.54)
.FooterDistance = CentimetersToPoints(0)
End With
With .Styles(wdStyleNormal)
With .Font
.Name = "Arial"
.Size = 10
End With
With .ParagraphFormat
.SpaceAfter = 0
.SpaceBefore = 0
.LineSpacingRule = wdLineSpaceSingle
End With
End With
If .Tables.Count > 0 Then .Tables(1).Delete
Set Rng = .Range
With Rng
.Style = wdStyleNormal
.Collapse wdCollapseStart
Set Tbl = .Tables.Add(Range:=Rng, NumRows:=1, NumColumns:=1, _
DefaultTableBehavior:=wdWord9TableBehavior)
With Tbl
.Borders.Enable = False
.TopPadding = CentimetersToPoints(0)
.BottomPadding = CentimetersToPoints(0)
.LeftPadding = CentimetersToPoints(0.19)
.RightPadding = CentimetersToPoints(0.19)
.Spacing = 0
.AllowPageBreaks = True
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = CentimetersToPoints(5.13)
With .Rows
.HeightRule = wdRowHeightAtLeast
.Height = CentimetersToPoints(2.55)
.WrapAroundText = True
.HorizontalPosition = CentimetersToPoints(14.78)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.DistanceLeft = CentimetersToPoints(0.32)
.DistanceRight = CentimetersToPoints(0.32)
.VerticalPosition = CentimetersToPoints(-0.85)
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
.DistanceTop = CentimetersToPoints(0)
.DistanceBottom = CentimetersToPoints(0)
.AllowOverlap = True
End With
End With
.End = Tbl.Range.End
.Collapse wdCollapseEnd
If strTTxt <> "" Then .InsertAfter strTTxt & vbCr
.Collapse wdCollapseEnd
Set Fld = .Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
Text:="MERGEFIELD LQCASE_NAME", PreserveFormatting:=False)
.End = Fld.Result.End + 1
.InsertAfter vbCr
.Collapse wdCollapseEnd
Set Fld = .Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
Text:="MERGEFIELD ADD", PreserveFormatting:=False)
.End = Fld.Result.End + 1
.InsertAfter vbCr & vbCr & vbCr & vbCr & vbCr & "Our Ref: "
.Collapse wdCollapseEnd
Set Fld = .Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
Text:="MERGEFIELD LQCASE_MAN_SEN", PreserveFormatting:=False)
.End = Fld.Result.End + 1
.InsertAfter "/" & strRef & "/"
.Collapse wdCollapseEnd
Set Fld = .Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
Text:="MERGEFIELD LQCASE_CASECODE", PreserveFormatting:=False)
.End = Fld.Result.End + 1
.InsertAfter vbCr & vbCr & vbCr & "Your Ref: "
.Collapse wdCollapseEnd
Set Fld = .Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
Text:="MERGEFIELD CREF", PreserveFormatting:=False)
.End = Fld.Result.End + 1
.InsertAfter vbCr & vbCr
.Collapse wdCollapseEnd
Set Fld = .Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
Text:="DATE \@ ""dd MMMM yyyy""", PreserveFormatting:=False)
.End = Fld.Result.End + 1
.InsertAfter vbCr & vbCr & vbCr
.Collapse wdCollapseEnd
End With
Set Rng = Tbl.Cell(1, 1).Range
With Rng
.End = .End - 1
Set Fld = .Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
Text:="MERGEFIELD GENERAL_ADD", PreserveFormatting:=False)
.End = Fld.Result.End + 1
.InsertAfter vbCr & vbCr
.Collapse wdCollapseEnd
.Text = "T:"
.Style = "Strong"
.Collapse wdCollapseEnd
.Text = " "
.Font.Reset
.Collapse wdCollapseEnd
Set Fld = .Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
Text:="MERGEFIELD GENERAL_TEL1", PreserveFormatting:=False)
.End = Fld.Result.End + 1
.InsertAfter vbCr
.Collapse wdCollapseEnd
.Text = "F:"
.Style = "Strong"
.Collapse wdCollapseEnd
.Text = " "
.Font.Reset
.Collapse wdCollapseEnd
Set Fld = .Fields.Add(Range:=Rng, Type:=wdFieldEmpty, _
Text:="MERGEFIELD GENERAL_TEL2", PreserveFormatting:=False)
End With
End With
Set Fld = Nothing: Set Tbl = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Variable arrays from user input | SeattleITguy | Excel Programming | 1 | 01-29-2015 09:19 AM |
| Taking input from InputBox from user | SeattleITguy | Excel Programming | 1 | 01-28-2015 09:05 AM |
vba: user input named argument
|
andrew12345 | Excel Programming | 2 | 11-18-2014 08:18 AM |
User input to a variable on the document
|
dsm1995gst | Word VBA | 1 | 09-03-2013 03:43 PM |
| Look up an array based on user input | johnsmb | Excel | 2 | 01-07-2011 01:12 PM |