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