#1
|
|||
|
|||
How to write individual lines of text with changing attributes.
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 Last edited by sts023; 05-26-2019 at 09:55 AM. Reason: Typo in code! |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Trying to add space between lines of bulleted text and a new header but both lines are moving??? | Martin_d35 | Word | 2 | 02-10-2017 07:13 AM |
Changing the size of individual cell | _mike1 | Word VBA | 1 | 11-25-2014 05:58 PM |
Editing .docx without changing lines, etc. | brettt777 | Word | 2 | 10-04-2013 01:14 AM |
write need help and copy write need help on another page auto | wykoems | Word | 2 | 07-25-2013 07:56 AM |
xml file attributes | seen2 | Word | 0 | 04-08-2010 07:36 AM |