View Single Post
 
Old 11-13-2015, 06:20 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,340
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote