Microsoft Office Forums - View Single Post - How to write individual lines of text with changing attributes.

sts023 · 05-26-2019, 07:43 AM

I know this isn't a reply to a post, but I tried to upload a help request yesterday and got caught out by a Virgin Media broadband failure (again! Thanks Virgin!).

I actually discovered one answer myself, so I'm posting it here in case others have similar problems.

I wanted to control the colour, size, font, and various other attributes of a line of text to be written to a document, but couldn't get my head around how to do it.
I'm fairly good at Excel VBA, and I think I was assuming that Word and Excel concepts with similar names meant the same thing.
As the song goes - "It ain't necessarily so!"

Anyway, following is the code (and a test harness) I built which seems to achieve what I want.

Note that the references to "ParagraphFormat" in the code are because in my programme I want single line spacing etc.
I've left it in the sample code in case it helps anyone else, but it's not necessary to achieve the changes in the text line(s).

It's probably a bit "over parameterised" for most needs, but if it helps you can always re-code it to pick and choose which bits you want.

"TestF3" is the harness, and "InsertText" is the routine.
Enjoy!

Code:

Sub TestF3()
Dim docMe               As Word.Document

  Set docMe = ActiveDocument
  docMe.StoryRanges(wdMainTextStory).Delete
  Call InsertText(docMe, _
                  "Some T", _
                  "Times New Roman", _
                  9, _
                  True, _
                  , _
                  wdUnderlineNone, _
                  wdRed)
  Call InsertText(docMe, _
                  "ext or o", _
                  "Calibri", _
                  20, _
                  True, _
                  True, _
                  wdUnderlineNone, _
                  wdBlack)

  Call InsertText(docMe, _
                  "ther here!" & vbLf, _
                  , _
                  9, _
                  False, _
                  , _
                  wdUnderlineNone, _
                  wdTeal)
  Call InsertText(docMe, "...and the next line" & vbLf)
  Call InsertText(docMe, "ending with ")
  Call InsertText(docMe, _
                  "this", _
                  "Comic Sans MS", _
                  22, _
                  True, _
                  True, _
                  wdUnderlineDouble, _
                  wdBlue)
End Sub
Public Sub InsertText(doc As Word.Document, _
                      strText As String, _
             Optional strFont As String = "Times New Roman", _
             Optional intFontSize As Integer = 12, _
             Optional booBold As Boolean = False, _
             Optional booItalic As Boolean = False, _
             Optional intUnderline As Integer = wdUnderlineNone, _
             Optional intColour As Integer = wdBlack)
'########################################################
'# Insert text into a document, controlling various     #
'# text attributes.                                     #
'# Parameters:-                                         #
'#   The document                                       #
'#   The text to write to the end of the document       #
'#   The Font name                  Defaults to         #
'#                                    "Times New Roman" #
'#   The Font size                  Defaults to 12      #
'#   The Font's Bold attribute      Defaults to Off     #
'#   The Font's Italic attribute    Defaults to Off     #
'#   The Font's Underline attribute Defaults to None    #
'#   The Font's colour              Defaults to Black   #
'#                                                      #
'# Author: Steve Ayton              May 2019            #
'#                                                      #
'# This code is made freely available to all,(but       #
'# without warranty), and is not subject to any         #
'# licensing restrictions.                              #
'########################################################
Dim rng                 As Range
'*
'** Address all text in the document,
'** then go to the end.
'*
  Set rng = doc.Range
  With rng
    .Start = .End
    With .ParagraphFormat
'*
'** Remove spacing before paragraphs.
'*
      .CloseUp
'*
'** Set line spacing for paragraph.
'*
      .LineSpacingRule = wdLineSpaceSingle
      .SpaceBefore = 0
      .SpaceAfter = 0
    End With 'ParagraphFormat
'*
'** Write the supplied text.
'** Note the line feeds etc. may be included
'** in the text.
'** Note also that it is necessary to write
'** the text before the font is formatted!
'*
    .Text = strText
    With .Font
      .Name = strFont
      .Bold = booBold
      .Italic = booItalic
      .Underline = intUnderline
      .ColorIndex = intColour
      .Size = intFontSize
    End With '.Font
  End With 'rng
End Sub 'InsertText