Add images and captions programmatically, with bold label - vba

I would like to add captions to figures where chapters would be included in the numbering, and the text "Figure x.x." was bold:
Figure 1.1. Sample figure.
Autocaptions is not possible because it will only allow for styles named Heading 1-9 to be considered as chapters, while I am using a custom style. As I understand, there is no way to include any personalised style to the list.
Please take into consideration that my knowledge of VBA is virtually nonexistant (I usually try to find a similar problem in multiple forums and adapt it using guides or other similar solved problems), so my error might be trivial for those who are more experienced. I could manage to write a macro to do almost everything I needed, but there is this one thing that is not working as expected.
Ideally, the macro would:
Prompt the user to select an image
Insert the image with a specific paragraph style
Insert a caption that includes chapter number with a custom paragraph style, instead of builtin ones
Search for "Figure x.x." text and make it bold using Find and Replace with wildcards <== This is where I'm having problems
Sub PicCaption()
Dim intChoice As Integer
Dim strPath As String
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
End If
'insert the image
Selection.InlineShapes.AddPicture FileName:= _
strPath, LinkToFile:=False, _
SaveWithDocument:=True
Selection.Range.Style = "Figures"
'Add caption in the form of "Figure x.x. "
Selection.TypeParagraph
Selection.TypeText Text:="Figure "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"STYLEREF ChapNum \n \t", PreserveFormatting:=False
Selection.TypeText Text:="."
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"SEQ Figure \* ARABIC", PreserveFormatting:=False
Selection.TypeText Text:="."
Selection.Style = ActiveDocument.Styles("Figures")
Selection.TypeText Text:=" "
'Make "Figure x.x." bold (last space not included)
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = False
.Text = "Figure*.*"
.Font.Bold = False
.MatchWildcards = True
.Replacement.Text = "^&"
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceOne, Forward:=True, _
Wrap:=wdFindContinue
End With
End Sub
The replacing bit does not make the recently inserted "Figure x.x." bold, but the next one in the text, even if I specified the search to be backwards. If I type .Execute Replace:=wdReplaceOne, Forward:=False, _, it goes to the end of the document and moves upwards, making everything bold.
In my sample document I have multiple already captioned images, but that wouldn't normally be the case; I would like to format captions as I insert them, instead of reformatting them when the document is finished.
Where is my mistake and why, if you were so kind to explain?
Thank you kindly.

I found my answer: for whatever reason, once fields are involved, finding and replacing does not work that well; i.e. it won't correctly find periods within "1.1.". I tried it with and without wildcards, using ?, * and anything I could think of.
I resorted to another method:
Select whole line
Make bold
Go to the end of the line
Uncheck bold so that the description has normal font width
'Code before this point remains identical
'Make "Figure x.x." bold (last space not included)
'Select from cursor point to beginning of line; make bold
Selection.MoveStart Unit:=wdLine, Count:=-1
Selection.Font.Bold = True
'Move cursor to end of the line; uncheck bold format
Selection.EndKey Unit:=wdLine
Selection.Font.Bold = wdToggle
This way, the cursor is placed right after the caption label, bold not selected. Seems clumsy and highly unprofessional, but works.
Thanks, everyone!

When Word inserts a caption it is basically providing a shortcut for the insertion of a number of fields and their associated switches.
Thus if we insert a Figure caption that references Heading 3 style for the chapter numbers we get something like
Figure 2.1.3-1: Text for the caption
If we highlight the 'Figure 2.1.3-1' in the Word document and press Shift-F9 this will show that the caption numbering is composed of a styleref field and a seq field
Figure {Styleref 3 \w}-{Seq Figure}
When the field codes are shown we can easily use the built in Find/Replace of word to change the text between the field brackets. So we could search for 'Styleref 3' and replace it with 'Styleref "Heading 2"' or in fact 'Styleref "myStyle"'.
If the Word wildcard search is used then you can simultaneously change the style ref to the desired style and apply the bold effect, thus achieving the effect that the OP desires. I'll leave that to a little research by the OP.
This is fine if we have to convert an existing document. If we are inserting Captions as we type then it would be preferable to use a macro to insert the caption numbering that is desired by firing a macro that inserts the appropriate caption numbering/formatting from a set of keystrokes.
The macro below will insert a caption of the type desired, use the defined style for chapter numbering and apply the bold effect to all the numbering upto the separating tab.
Option Explicit
' Any Leading and Trailing spaces in the Const definition strings are deliberate
' Heading 2 is used for ease of demonstration. Heading 2 should be replaced by the style
' from which you wish to take the heading numbers.
Const SpecialCaptionStyle As String = """Heading 2""" ' Name of the style to reference for the heading number
Const CaptionType As String = "Figure " ' The trailing space is required
Const CaptionNUmberingStyle As String = " \w " ' see switches for the styleref field
Const CaptionNumberSeparator As String = "-"
Public Sub InsertSpecialCaption()
' Get the range into which we insert the styleref and seq fields
Dim myFieldRange As Word.Range
Set myFieldRange = Selection.Range
'Preserve the srarting range for later use
Dim myEffectRange As Word.Range
Set myEffectRange = Selection.Range.Duplicate
'Set the style to Caption style.
'Caption style will be applied to any text in the paragraph of the selection point
myFieldRange.Collapse direction:=wdCollapseEnd
myFieldRange.Paragraphs.Item(1).Style = myFieldRange.Document.Styles(wdStyleCaption)
'Insert the label of the caption type. In this case it is the text 'Figure'
myFieldRange.InsertAfter Text:=CaptionType
myFieldRange.Collapse direction:=wdCollapseEnd
Dim myField As Word.Field
' Insert the styleref field to obtain the heading number of the style we specify
Set myField = myFieldRange.Document.Fields.Add(Range:=myFieldRange, Preserveformatting:=False)
myField.Code.Text = "Styleref " & SpecialCaptionStyle & CaptionNUmberingStyle
Set myFieldRange = myField.Result
'Insert the text string used as a seperator between the chapter number and the captiontype number
myFieldRange.InsertAfter Text:=CaptionNumberSeparator
myFieldRange.Collapse direction:=wdCollapseEnd
' Insert the Seq field to get the sequential number of the caption
' in this case we use the same name of the label but it could be different
Set myField = myFieldRange.Document.Fields.Add(Range:=myFieldRange, Type:=wdFieldEmpty, Preserveformatting:=False)
myField.Code.Text = "Seq " & CaptionType
Set myFieldRange = myField.Result
myFieldRange.Collapse direction:=wdCollapseEnd
' Insert the seperator text from the number to the Caption text NB I always use : followed by a tab
myFieldRange.InsertAfter Text:=":" & vbTab
' Adjust the range to omit the tab from formatting
' update the fields
' Apply bold effect to the inserted caption label
myFieldRange.MoveEnd unit:=wdCharacter, Count:=-1
myEffectRange.End = myFieldRange.End
myEffectRange.Fields.Update
myEffectRange.Font.Bold = True
End Sub
All that is required is to link the macro to a suitable key sequence, which is the provenance of the OP.
First though, I'd strongly suggest using F8 to step through the macro to see how the Caption number is inserted.

Related

VBA Word - .Find "[space]" always find matches outside the selection range thus loops undefinitely

When converting a table from PDF to word, I ended up with a format similar to the following:
([space] is a space character)
Text [space.spacing 10pts] Text [space.spacing 30pts] Text
Text [space.spacing 14pts] Text [space.spacing 31pts] Text
Text [space.spacing 12pts] Text [space.spacing 33pts] Text
Instead of a regular table with 3 columns and 3 rows containing each « Text » such as below
Text
Text
Text
Text
Text
Text
Text
Text
Text
In other words, instead of creating a column, the PDF conversion has created a regular paragraph, mimicking columns by adjusting [spaces].spacing according to the length of the text within the column.
So my inital thought was that it should be possible to recreate a table by identifing the spacing of each space for each paragraph of the converted table, eventually replacing them with identifiable symbols so I can convert the text into a table later on.
My idea was somewhat the following :
' For each paragraph of the selected text (which is the converted table)
' Find all [space] within the paragraph range
' If a [space] is found, check its spacing
' 1st case : [space].spacing is <= 1 pts (so a normal space)
' Do nothing
' 2nd case : [space].spacing is >= 10 pts (so previous Text is supposed to be within a small column)
' insert ££ (symbol for small column)
' 3rd case [space].spacing is >= 30 pts (so previous Text is supposed to be within a small column)
' insert §§ (symbol for large column)
' Once all [space] are found within the current paragraph, do the same with the next paragraph, until the last paragraph of the selected text
My current code is the following :
Private Sub Test()
Dim RngSearch As Range
Dim RngCurrent As Range
Dim Paragraph As Paragraph
For Each Paragraph In ActiveDocument.Paragraphs
Set RngCurrent = Paragraph.Range
RngCurrent.Select 'For testing purposes
With RngCurrent.Find
.Text = " "
Do While RngCurrent.Find.Execute
RngCurrent.Select 'For testing purposes
Select Case RngCurrent.Font.Spacing
Case Is >= 30
RngCurrent.Font.Spacing = 1
RngCurrent.InsertAfter ("§§")
Case Is >= 10
RngCurrent.Font.Spacing = 1
RngCurrent.InsertAfter ("¤")
Case Else
' Do Nothing
End Select
Loop
End With
Next Paragraph
End Sub
So it kinda word with one issue : it loops infinitely. Each time the text is finished, it goes back again indefinitely.
I managed to track the issue to the following code :
With RngCurrent.Find
.Text = " "
Do While RngCurrent.Find.Execute
RngCurrent.Select
' Use Case function
Loop
End With
Without it, the looping through paragraphs works normally (it ends at the last paragraph)
For Each Paragraph In ActiveDocument.Paragraphs
Set RngCurrent = Paragraph.Range
RngCurrent.Select
' Code here
Next Paragraph
But once .find.text (" ") is injected, it actually doesn't look within each Paragraphs.Range anymore as I supposed Do While RngCurrent.Find.Execute should have established.
I feel like the solution is something very stupid, but I've been searching for the reason why or alternatives for 2 days now. Everytime, it stops acting as per my understading when I'm using .find(" ").
I already tried using .wrap = wdFindStop, but it stops at the first match within the paragraph, and goes to the next paragraph prematurely.
With RngCurrent.Find
.Text = " "
.wrap = wdFindStop
Do While RngCurrent.Find.Execute
RngCurrent.Select
' Use Case function
Loop
End With
Strangely .wrap = wdFindAsk doesn't ask me anything... maybe that means something.
I believe it's because there are always spaces within each paragraph ? So it can loops indefinitely?
You're way over-complicating things:
Sub MakeTable()
Application.ScreenUpdating = False
Dim i As Single
With Selection
i = .Characters.First.Font.Size
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Wrap = wdFindStop
.Text = " "
.Replacement.Text = "^t"
.Replacement.Font.Size = i
.Font.Size = 10
.Execute Replace:=wdReplaceAll
.Font.Size = 30
.Execute Replace:=wdReplaceAll
End With
.ConvertToTable Separator:=vbTab
End With
Application.ScreenUpdating = True
End Sub
So I finally found not exactly a solution but a workaround for anyone who may need a similar solution. Instead of using a .find =" ", I decided to go the "hard" path and check for every word in a paragraph (which in MS Word, seems to end with a [space] character). Then, I check for the last character of a word (which is often a space) if its spacing is superior to a value. It the case, do something.
For Each RngWord In Paragraph.Range.Words
Set RngChar = RngWord.Characters.Last
Select Case RngChar.Font.Spacing
Case Is > 300
RngChar.Font.Spacing = 1
RngChar.InsertAfter ("£")
Case Is > 100
RngChar.Font.Spacing = 1
RngChar.InsertAfter ("#")
Case Is > 15
RngChar.Font.Spacing = 1
RngChar.InsertAfter ("¤")
Case Else
' Do Nothing
End Select
Next RngWord
It does the job, and isn't that slow, but I guess there are better solution :)

Using VBA to Set Multiple Styles in the Footer in Word

I am new to VBA in Word with some experience in Excel. I am trying to produce a Word document from an Excel file. The first task is to set up the headers and footers, which I am struggling with. For context, I have added the reference to Word in Excel and will likely convert to late-binding at a later date because this is a tool I will distribute to peers. The goal of this macro is to generate a document with data that matches a report format, so the formatting is not my choice; I have to match it as the Word template is set up. At this point I am not using late binding so that I can use Intellisense while I learn this.
Requirements for the footer:
Centered text, Arial, size 8: "Page " and then an automatically generated page number.
Right-aligned text, Arial, size 8, bold: "Other Support Page"
A top line border for the entire footer.
What I want:
I can get most of this to function except it's either entirely bold or entirely not bold. I have looked into using "Collapse 0", however, it screws up the top border. Also, I have tried to use style objects to lower the amount of code, but it then wipes out the default tab stops. I am struggling to add the tab stops back into the footer (center 3.25" and right 6.5"). I have no problem adding tab stops in the body, but for some reason the code executes but does nothing with the tab stops when I try and put them in the footer. First try here has it set up correctly, but bolds the entire thing:
With rngFooter
.Font.Name = "Arial"
.Font.Size = "8"
.Fields.Add rngFooter, wdFieldPage, , False
.InsertBefore vbTab & "Page "
.Font.Bold = True
.InsertAfter vbTab & "Other Support Page"
With rngFooter.Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = Options.DefaultBorderColor
End With
End With
I have read about moving styles until after the text you want to format. So if I were to use the styles I have created, the tab stops get wiped out and the formatting isn't right anyways (the "b" in the style name means it is set to bold):
With rngFooter
.Fields.Add rngFooter, wdFieldPage, , False
.InsertBefore vbTab & "Page "
.Style = A8
.InsertAfter vbTab & "Other Support Page"
.Style = AB8
With rngFooter.Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = Options.DefaultBorderColor
End With
End With
If I add the collapse in, it screws up the borders.
With rngFooter
.Fields.Add rngFooter, wdFieldPage, , False
.InsertBefore vbTab & "Page "
.Style = A8
.Collapse 0
.InsertAfter vbTab & "Other Support Page"
.Style = AB8
With rngFooter.Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = Options.DefaultBorderColor
End With
End With
I really want to understand how to do this properly because I will also be trying to change styles mid-way through table cells. I find the documentation on how ranges work to be confusing, but I do understand that the point of the collapse is to prevent it from overwriting the entire footer, which is what I was doing before. I just can't see how I can do the collapse and then also apply the top-line border to the whole footer. I have to put it in at the end also or it interferes with the page number.
Thank you Timothy Rylatt for the pointers to alignment tabs and character styling. I was able to avoid tables and generating a template file (which would be a lot more work as I need to distribute this Excel file to many users). My solution is as follows:
With rngFooter
.Style = A8
.InsertAlignmentTab 1, 0
.InsertAlignmentTab 2, 0
.Fields.Add rngFooter, wdFieldPage, , False
.InsertBefore vbTab & "Page "
.InsertAfter vbTab & "Other Support Page"
End With
' Make "Other Support Page" bold
With rngFooter.Find
.ClearFormatting
.Text = "Other Support Page"
.Replacement.ClearFormatting
.Replacement.Style = AB8
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceOne
End With
'Add border to entire footer
With rngFooter
.Expand Unit:=wdParagraph
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = Options.DefaultBorderColor
End With
End With
Essentially I applied the base style (now a character style and not a paragraph style), then inserted the alignment tabs as the base tab stops from the Normal template were wiped out. I then add the page number, then the "Page " text, then the "Other Support Page" text. I do a find and replace on the specific expression to format, and apply a character style to ensure it doesn't expand the formatting to the full paragraph. The border issue is fixed by using .Expand on the range prior to applying the border. Order of operations was very important to making this work.
For me, the documentation on the Word object model is more confusing than Excel is, and I appreciate the specific topics to research. I also used this StackOverflow answer for the tip on using find and replace to change the styles, which worked once they were converted to Character Styles.
Do not use tabs for alignment because they are part of the paragraph and a paragraph can only have one style without some trickery.
By far the easiest way to get what you want is to follow this procedure which can be applied to either headers or footers
Insert a 1 row, 3 column table to get left, center and righgt 'fields'
Turn off the table borders
Insert the relevant text into each cell
Set the formatting of paragraph(1) of each cell
If required, turn on the bottom border of the Header Table and or the Top border of the Footer table.
If stuck for vertical space you might need to set the font hieght of the compulsory row after each table to 1 or 2 points.
Be aware that each section in the document has its own Headers and Footers and that there are three headers and three footers in each section.

MS Word: Getting the actual ASCII code of an inserted symbol

I am trying to write a VBA code for MS-Word to remove rows with the unticked symbol from a table.
To do that, I need MS-Word to recognize it and differentiate between it and the ticked symbol. But unlike Excel, MS-Word seems to be bad at it.
To focus on the problem, I inserted the symbols, but I can not get the correct ASCII code of the character I have just inserted.
Here is what I tried:
Sub SymbolsTest()
Selection.InsertSymbol 163, "Wingdings 2", True 'Insert unticked
Selection.MoveRight Unit:=wdCharacter, Count:=-1, Extend:=wdExtend 'Select it
Debug.Print AscW(Selection.Text) & " " & Selection.Text 'Ask for ASCII
Selection.Collapse 0
Selection.InsertSymbol 82, "Wingdings 2", True 'Insert ticked
Selection.MoveRight Unit:=wdCharacter, Count:=-1, Extend:=wdExtend 'Select it
Debug.Print AscW(Selection.Text) & " " & Selection.Text 'Ask for ASCII
End Sub
The output is:
40 (
40 (
I would expect it to be:
163 ?
82 ?
I also tried ?Selection.Characters(1) = Selection.Characters(2) in the immediate window while selecting both of them, and I got True
Any help would be appreciated.
As far as I know
there is no simple way to get the character's code point or font name directly using any of the properties of the Selection or Range
In this situation, Word always uses the code point 40 (")"), and internally, it does does store the name of the font you specified and a Unicode codepoint (e.g. U+F052 for the checked box).
Two things you can do. If the character is not 40, assume it already has the correct codepoint (although I am not certain about that). But if not,
retrieve the .XML or .WordOpenXML of the Selection or Range and look for the relevant element, e.g. ><w:sym w:font="Wingdings 2" w:char="F052"/> in both the old-style .XMLand the newer .WordOpenXML. You could either search for the text <w:sym and look for the font and codepoint in the following text, or "do it properly" using an XML parser. In that case, it may be useful to know that F052 either means "the Unicode character with code point F052, or it means "it's F000 + the code point in the original character set", i.e. Wingdings 2 in this case.
e.g. one way would be to make a reference in the VB Editor's Tools-References to the Microsoft XML library (in this case 6.0) and use code along these lines:
Sub getCharFontAndCodepoint()
Dim xdoc As MSXML2.DOMDocument60
Dim xSymNodes As MSXML2.IXMLDOMNodeList
Set xdoc = New MSXML2.DOMDocument60
xdoc.async = False
If xdoc.LoadXML(Selection.XML) Then
xdoc.SetProperty _
"SelectionNamespaces", _
"xmlns:w='http://schemas.microsoft.com/office/word/2003/wordml'"
Set xSymNodes = xdoc.SelectNodes("//w:sym/#w:font")
If xSymNodes.Length > 0 Then
Debug.Print xSymNodes(0).NodeValue
End If
Set xSymNodes = xdoc.SelectNodes("//w:sym/#w:char")
If xSymNodes.Length > 0 Then
Debug.Print xSymNodes(0).NodeValue
End If
End If
Set xSymNodes = Nothing
Set xdoc = Nothing
End Sub
or, if you only need the codepoint, copy the character and use paste special to paste it using the Unformatted Unicode Text format, e.g.
Selection.Copy
Selection.PasteSpecial link:=False, DataType:=22 ' There does not seem to be a named enum for this particular format
Selection.MoveLeft Unit:=WdUnits.wdCharacter, Count:=1, Extend:=WdMovementType.wdExtend
Debug.Print Hex(AscW(Selection))
Selection.Document.Undo

Finding and Replacing with VBA for Word overwrites previous style

I'm writing a VBA script to generate word documents from an already defined template. In it, I need to be able to write headings along with a body for each heading. As a small example, I have a word document that contains only <PLACEHOLDER>. For each heading and body I need to write, I use the find-and-replace feature in VBA to find <PLACEHOLDER> and replace it with the heading name, a newline, and then <PLACEHOLDER> again. This is repeated until each heading name and body is written and then the final <PLACEHOLDER> is replaced with a newline.
The text replacing works fine, but the style I specify gets overwritten by the next call to the replacement. This results in everything I just replaced having the style of whatever my last call to my replacement function is.
VBA code (run main)
Option Explicit
Sub replace_stuff(search_string As String, replace_string As String, style As Integer)
With ActiveDocument.Range.Find
.Text = search_string
.Replacement.Text = replace_string
.Replacement.style = style
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWholeWord = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub
Sub main()
Dim section_names(2) As String
section_names(0) = "Introduction"
section_names(1) = "Background"
section_names(2) = "Conclusion"
Dim section_bodies(2) As String
section_bodies(0) = "This is the body text for the introduction! Fetched from some file."
section_bodies(1) = "And Background... I have no issue fetching data from the files."
section_bodies(2) = "And for the conclusion... But I want the styles to 'stick'!"
Dim i As Integer
For i = 0 To 2
' Writes each section name as wsStyleHeading2, and then the section body as wdStyleNormal
Call replace_stuff("<PLACEHOLDER>", section_names(i) & Chr(11) & "<PLACEHOLDER>", wdStyleHeading2)
Call replace_stuff("<PLACEHOLDER>", section_bodies(i) & Chr(11) & "<PLACEHOLDER>", wdStyleNormal)
Next i
Call replace_stuff("<PLACEHOLDER>", Chr(11), wdStyleNormal)
End Sub
Input document: A word document with only <PLACEHOLDER> in it.
<PLACEHOLDER>
Expected Output:
I expect that each heading will be displayed in the style I specified and can be viewed from the navigation pane like this:
Actual Output: However what I actually get is everything as wdStyleNormal style like this:
I think the problem can be solved by inserting a paragraph break between every style transition, but when I try using vbCrLF or Chr(10) & Chr(13) or vbNewLine instead of the chr(11) I am using now, Each line begins with a boxed question mark like this:
Update from discussion in comments on another answer. The problem described below applies to Word 2016 and earlier. Starting in Office 365 (and probably Word 2019, but that's not been confirmed) the Replace behavior has been changed to "convert" ANSI 13 to a "real" paragraph mark, so the problem in the question would not occur.
Answer
The reason for the odd formatting behavior is the use of Chr(11), which inserts a new line (Shift + Enter) instead of a new paragraph. So a paragraph style applied to any part of this text formats the entire text with the same style.
In this particular case (working with Replace), vbCr or the equivalent Chr(13) also don't work because these are not really Word's native paragraph. A paragraph is much more than just ANSI code 13 - it contains paragraph formatting information. So, while the code is running, Word is not really recognizing these as true paragraph marks and the paragraph style assignment is being applied to "everything".
What does work is to use the string ^p, which in Word's Find/Replace is the "alias" for a complete paragraph mark. So, for example:
replace_stuff "<PLACEHOLDER>", section_names(i) & "^p" & "<PLACEHOLDER>", wdStyleHeading2
replace_stuff "<PLACEHOLDER>", section_bodies(i) & "^p" & "<PLACEHOLDER>", wdStyleNormal
There is, however, a more efficient way to build a document than inserting a placeholder for each new item and using Find/Replace to replace the placeholder with the document content. The more conventional approach is to work with a Range object (think of it like an invisible selection)...
Assign content to the Range, format it, collapse (like pressing right-arrow for a selection) and repeat. Here's an example that returns the same result as the (corrected) code in the question:
Sub main()
Dim rng As Range
Set rng = ActiveDocument.content
Dim section_names(2) As String
section_names(0) = "Introduction"
section_names(1) = "Background"
section_names(2) = "Conclusion"
Dim section_bodies(2) As String
section_bodies(0) = "This is the body text for the introduction! Fetched from some file."
section_bodies(1) = "And Background... I have no issue fetching data from the files."
section_bodies(2) = "And for the conclusion... But I want the styles to 'stick'!"
Dim i As Integer
For i = 0 To 2
BuildParagraph section_names(i), wdStyleHeading2, rng
BuildParagraph section_bodies(i), wdStyleNormal, rng
Next i
End Sub
Sub BuildParagraph(para_text As String, para_style As Long, rng As Range)
rng.Text = para_text
rng.style = para_style
rng.InsertParagraphAfter
rng.Collapse wdCollapseEnd
End Sub
The problem is caused by your use of Chr(11) which is a manual line break. This results in all of the text being in a single paragraph. When the paragraph style is applied it applies to the entire paragraph.
Replace Chr(11) with vbCr to ensure that each piece of text is in a separate paragraph.

How to replace Fields in Word document with their content using VBA?

Some sites use textarea to publish code in articles. If someone copy/paste the article in Word, it shows empty textarea with scrollbars and below the code in a table with numbered lines.
I want to replace it with just code (or with just the table, which I can successfully convert to text), by removing the textarea.
Did try to do it like this
Sub RemoveTextBoxes()
Dim oFld As Word.FormField
With Application.ActiveDocument
' \\ TextInput Type requires to unprotect the document
If .ProtectionType <> wdNoProtection Then .Unprotect
' \\ Loop all formfields in active document
For Each oFld In .FormFields()
' \\ Only remove Formfield textboxes that have textinput only
If oFld.Type = wdFieldFormTextInput And oFld.TextInput.Type = wdRegularText Then
' \\ Delete
oFld.Delete
End If
Next
' \\ Reprotect the document
.Protect wdAllowOnlyFormFields, True
End With
End Sub
If I press Alt+F9 (displays field codes) I do see now
{ HTMLCONTROL Forms.HTML :TextArea.1 }
above the text box with scrollbars! If I close and open up again, it's still here.
How do I get this TextArea content and remove|replace the element with the content?
Dynamic content in Word is managed using "fields". Not all fields that accept input are "form fields", as you discovered when using Alt+F9 do display the field codes.
Word's Find / Replace functionality is quite powerful: it can also be used to find fields, even specific fields. In this case, since you simply want them removed, the HTMLControl fields can be found and replaced with "nothing". (If you want to be more specific and leave some HTMLControl fields, use as much text as necessary to remove only those fields.)
Many people don't realize it, but you can search field codes without needing to display them. Find can also work with field results displayed. The trick is to set the Range.TextRetrievalMode to include field codes (and, in this case, I think also inlcuding hidden text is a good idea, but if that's a problem, comment out or delete that line).
The ^d in the search text represents the opening field bracket: { - if this were left out only what is inside the brackets would be replaced (deleted), which I don't recommend. With ^d the entire field - including the closing bracket - is affected.
Sub FindAndDeleteHtmlFields()
Dim doc As word.Document
Dim fld As word.Field
Dim rngFind As word.Range
Set doc = ActiveDocument
Set rngFind = doc.content
rngFind.TextRetrievalMode.IncludeFieldCodes = True
rngFind.TextRetrievalMode.IncludeHiddenText = True
With rngFind.Find
.Text = "^d HTMLControl"
.ClearFormatting
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
End Sub
Note that this also ports to C# - I have the impression that's actually where you're working...