I have some word documents that have custom heading styles.
I would like to iterate through all custom headings in a document, and replace the custom style with the standard heading style.
For example:
Custom Style Standard Style
=================== ==============
Heading 1. Numbered --> Heading 1
Heading 2. Numbered --> Heading 2
Heading 3. Numbered --> Heading 3
and so on up to Heading 5 ...
I am using MS Word 2007.
Question: how can I do this with VBA?
This worked for me:
Sub Macro1()
Dim DocPara As Paragraph
For Each DocPara In Application.ActiveDocument.Paragraphs
If DocPara.Range.Style Is Nothing Then
' do nothing
Else
Dim I As Integer
Dim H As String
For I = 1 To 5
H = "Heading " + CStr(I) + ". Numbered"
If Left(DocPara.Range.Style, Len(H)) = H Then
DocPara.Range.Style = "Heading " + CStr(I)
End If
Next I
End If
Next
End Sub
Code adapted from: https://stackoverflow.com/a/276397/1033422
Related
I am wondering if it is possible to get to the end of the list in vba? For example, I have a document with manual numbering and autonumbering in word.
Now, I would like to apply styles. But, when applying styles to auto - numbered list the numbering would be removed upon applying another style. So, to overcome this problem I am wondering if it is possible to get to the end of the list. So, that I would convert autonumbering into manual number and apply the formatting.
Sub applyformatting()
pos2 = Selection.Range.End
pos1 = Selection.Range.Start
Dim i As Integer, para As Paragraph
For i = 1 To ActiveDocument.Range.Paragraphs.Count
Set para = ActiveDocument.Range.Paragraphs(i)
If para.Range.ListFormat.ListType <> wdListBullet Or para.Range.ListFormat.ListType <> wdListSimpleNumbering Then
' Goto the end of the list and do the following until it reaches current paragraphs
Do Until Selection.Range.Start = pos1
Selection.MoveUp wdParagraph, 1
para.Range.ListFormat.ConvertNumbersToText
para.Range.Style = "tt"
Loop
Else
para.Range.Style = "t"
End If
Next
End Sub
Greeting to all Members and Experts, I am trying to automate
the formatting process in word. The formatting is done by applying styles. But before applying styles I need to trim extra spaces between characters of serial numbers, for example, 1. a. i. and insert tabs after dot(.) and then apply the style. I have attached a sample document. Plz have a look. I have tried to get the desired result by using the following code but it doesn't get the work done
I am new here so i dont know how to attach sample files so, here is the link for sample file. https://docs.google.com/document/d/1Z1dB6tvPKVrxHlw7qV8VNyiy49c5lRZN/edit?usp=sharing&ouid=101706223056224820285&rtpof=true&sd=true
Any help or suggestion would be of great help. Thanks in advance...
Sub formatts()
Dim a As Integer
Dim i As Integer, n As Long, para As Paragraph, rng As Range, doc As Document
Set doc = ActiveDocument
With doc
For i = 1 To .Range.Paragraphs.Count
For n = 1 To doc.Paragraphs(i).Range.Characters.Count
If .Paragraphs(i).Range.Characters(n).Text = " " Or .Paragraphs(i).Range.Characters(n).Text = Chr(9) Or .Paragraphs(i).Range.Characters(n).Text = Chr(160) Then
.Paragraphs(i).Range.Characters(n).Select
'This line checks whether the first character is whitespace character or not and delete it.
doc.Paragraphs(i).Range.Characters(n).Delete
ElseIf .Paragraphs(i).Range.Characters(n).Text = "." Then
.Paragraphs(i).Range.Characters(n).InsertAfter (vbTab)
n = n + 1
a = a + 1
ElseIf .Paragraphs(i).Range.Characters(n).Text Like "[a-z]." And .Paragraphs(i).Range.Characters(n).Next.Next.Text <> "i" Then
Exit For
End If
If a >= 3 Then Exit For
Next
For n = 1 To doc.Paragraphs(i).Range.Characters.Count
If .Paragraphs(i).Range.Characters(n).Text = "i" And .Paragraphs(i).Range.Characters(n).Next.Text = "." And .Paragraphs(i).Range.Characters(n).Next.Next.Text = " " Then
doc.Range.Paragraphs(i).Style = "shh"
Exit For:
ElseIf .Paragraphs(i).Range.Characters(n).Text = "a" Or .Paragraphs(i).Range.Characters(n).Text = "b" Or .Paragraphs(i).Range.Characters(n).Text = "c" And .Paragraphs(i).Range.Characters(n).Next.Text = "." And .Paragraphs(i).Range.Characters(n).Next.Next.Text = " " Then
doc.Range.Paragraphs(i).Style = "sh"
Exit For
End If
Next
Next
End With
End Sub
I have a MS Word document (2016) containing text with different fonts like this
Abc.q
Defq
// Abc. has font size = 20 pt and q that represents paragraph mark has font size=10 pt
// Def has font size = 16 pt and q (paragraph mark) has font size=10 pt
The paragraph mark is equivalent to carriage return CR (^13)
Then, how can I replace the paragraph mark with string but only for the texts that have font size = 20 pt, this is in this case only Abc. and result would be Abc.string using Advance Find/Replace or VBA?
I tried:
Find: ^13 --> with font 10pt
Replace: string
But that replaces paragraph mark with string in all cases. I even tried creating a new style with font = 20.pt and in option Style for following paragraph I set q Normal (Where q represents paragraph mark).
Thanks for any help.
It could simply done (without using Find method) like this
Sub ReplacePara()
Dim Para As Paragraph, Xstr As String, Rng As Range
Xstr = "String to be added"
For Each Para In ActiveDocument.Paragraphs
ln = Para.Range.Characters.Count
If ln > 1 Then
If Para.Range.Characters(ln - 1).Font.Size = 20 Then
Para.Range.Text = Left(Para.Range.Text, ln - 1) & Xstr
Set Rng = ActiveDocument.Range(Start:=Para.Range.Start, End:=Para.Range.Start + ln - 1 + Len(Xstr))
Rng.Font.Size = 20
End If
End If
Next
End Sub
Tested to achieve what I understand as your requirement
Edited to assign a Font size of preceding text (i.e 20) for added string. Font name, Bold, italics etc properties (gathered by Para.Range.Characters(ln - 1).Font........ to a variable before replacement) could also be assigned to added text in same way.
The following code works fine for finding exact duplicate paragraphs within a Word document. It ignores paragraphs shorter than min_chars length but I also want it to ignore paragraphs that are of a certain style.
So can someone help me with the syntax to add 'or if left(paragraph style, 3) <> "XXX" ' to the first If statement?
Many thanks!
ReDim Para_text(1 To Para_count) 'i.e. to last paragraph in document
For Para_num = 1 To Para_count
Para_text(Para_num) = ActiveDocument.Paragraphs(Para_num).range.Text
Next Para_num
For Para_A = 1 To Para_count
For Para_B = Para_A + 1 To (Para_count - 1)
'Ignore paragraphs < min_chars characters in length (entered on user form, default 100)
If Para_text(Para_A) Like "**" Or Para_text(Para_B) Like "**" Or Len(Para_text(Para_A)) < Form_min_chars_box Or Len(Para_text(Para_B)) < Form_min_chars_box Then
Else
If Para_text(Para_A) = Para_text(Para_B) Then
ActiveDocument.Paragraphs(Para_A).range.Select
Page_A = Selection.Information(wdActiveEndPageNumber)
ActiveDocument.Paragraphs(Para_B).range.Select
Page_B = Selection.Information(wdActiveEndPageNumber)
' Add a comment at this found location:
Call Repeat_Comment(Count_repeats, Para_A, Para_B, Page_A, Page_B)
End If
End If
Next Para_B
Next Para_A
Sub Repeat_Comment(Count_repeats As Integer, Para_A As Integer, Para_B As Integer, Page_A As Integer, Page_B As Integer)
'Adds a comment whenever a duplicate paragraph is found
Count_repeats = Count_repeats + 1
Selection.Paragraphs(1).range.Characters(1).Select
With ActiveDocument.Comments.Add(Selection.range, "This paragraph is also on page " & Page_A)
.Initial = "Repeat "
.Author = "Repeated"
End With
End Sub
I am fairly new to VBA. I tag text with heading styles in large documents from a variety of authors. Is it possible identify a number pattern on a line of bolded text, and apply the appropriate style to that entire line (there is usually a hard return at the end of the line).
For example, often our documents are numbered as shown below, and we tag the text accordingly.
1.0 text here (apply Heading 1)
1.2 text here (apply Heading 2)
1.2.1 text here (apply Heading 3)
1.2.1.1 text here (apply Heading 4)
2.0 text here (apply Heading 1)
2.2 text here (apply Heading 2)
….and so on
I have done a lot of research, but I am not sure if this is possible. We do not use any type of auto numbering.
Yes, it's possible. Try this code:
Sub ApplyHeadings()
Dim rg1 As Range
Dim rg2 As Range
Dim pos As Long
Dim i As Long
Dim dots As Long
Set rg1 = ActiveDocument.Range
With rg1.Find
.MatchWildcards = True
.Text = "[0-9.]{2,}[!^13]#[^13]"
.Wrap = wdFindStop
While .Execute
Set rg2 = rg1.Duplicate
dots = 0
' isolate the numbering
pos = InStr(rg2.Text, " ")
If pos > 0 Then rg2.End = rg2.Start + pos - 1
For i = 1 To Len(rg2.Text)
' count the dots in the number
If Mid(rg2.Text, i, 1) = "." Then dots = dots + 1
Next i
' apply correct heading level
Select Case dots
Case 1
If Mid(rg2.Text, 3, 1) = "0" Then
rg1.Style = ActiveDocument.Styles("Heading 1")
Else
rg1.Style = ActiveDocument.Styles("Heading 2")
End If
Case 2, 3 ' maybe more...
rg1.Style = ActiveDocument.Styles("Heading " & CStr(dots + 1))
Case Else
' do nothing
End Select
' prepare for next find
rg1.Collapse wdCollapseEnd
Wend
End With
End Sub