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
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 been using this code to Bold-Underline all the headers in my word doc:
Sub Underline_Headers()
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
If Len(p.Range.Text) < 70 Then
p.Range.Font.Underline = True
p.Range.Font.Bold = True
End If
Next p
End Sub
This works great - as long as every header is less than 70 characters long, and the paragraph underneath it is 70 or more characters.
But many times the header can be longer than 70 characters, and the paragraph under the header can be less than 70 characters.
However, the headers always never end with any punctuation, like a "." but the paragraphs underneath them always do.
I am trying to fix the code above to look for all paragraphs not ending in a "." and then Bold-Underline them. In other words, I want to change the rule.
I tried the only thing that made sense to me. The code did not break, but it ended up bold-underline the entire document:
Sub Underline_Headers()
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
If Right(p.Range.Text,1) <> "." Then
p.Range.Font.Underline = True
p.Range.Font.Bold = True
End If
Next p
End Sub
This supposedly looks for all paragraphs where the last character is not ".", which if that worked, would isolate all the headers and only bold-underline them, but obviously that doesn't work.
The last character in every paragraph is a carriage return, Chr(13). The text ends one character before that. The code below also considers the possibility that someone ended a paragraph's text with one or more blank spaces. It takes the "cleaned" string and looks for the last character in a string of possible exceptions, like .?!. You can reduce this string to a single full stop or extend it to include more cnadidates for exception.
Private Sub UnderlineTitles()
Dim Para As Paragraph
Dim Txt As String
Application.ScreenUpdating = False
For Each Para In ActiveDocument.Paragraphs
Txt = Para.Range.Text
Txt = RTrim(Left(Txt, Len(Txt) - 1))
' you can extend the list to include characters like ")]}"
If InStr(".?!", Right(Txt, 1)) = 0 Then
' to choose a different style of underline, remove
' "= wdUnderlineSingle", type "=" and select from the dropdown
Para.Range.Font.Underline = wdUnderlineSingle
End If
Next Para
Application.ScreenUpdating = True
End Sub
I’m attempting to add formatted entries from a table in MSWord 2016 document to the autocorrect library (which is stored in normal.dotx as usual for formatted entries).
In the document I have a table containing two columns, the left column has the short text and the right column has the formatted long text for the autocorrect entries.
I have a working macro for storing unformatted text using the line AutoCorrect.Entries.Add Name:=ShortText, Value:=LongText.
I’m trying to modify it to use the AutoCorrect.Entries.AddRichText ShortText, longtext function which should then pick up the font and italics properties in the table.
I tried two methods.
FIRST - testAddRichText1
Here’s the code (removed some of the cosmetics)
Sub testAddRichText1()
Set oDoc = ActiveDocument
For i = 1 To oDoc.Tables(2).Rows.Count
If oDoc.Tables(2).Rows(i).Cells(1).Range.Characters.Count > 1 Then
ShortText = oDoc.Tables(2).Cell(Row:=i, Column:=1)
ShortText = Left(ShortText, Len(ShortText) - 2) 'remove the trailing CR and LF
longtext = oDoc.Tables(2).Cell(Row:=i, Column:=2)
StatusBar = "Adding " & ShortText & " = " & longtext.Text
AutoCorrect.Entries.AddRichText ShortText, longtext
End If
Next i
MsgBox "done"
End Sub
Using this code, there are a number of unprintable characters at the end of the text extracted from the cell, mostly Chr(13)’s. I tried running a cleaner over the string to remove all non-printable characters, but there is something there that just won’t go away and causes a black box at the end of the corrected text when the autocorrect is used. I assume it’s some sort of secret word code that is in the table cell. Attempting to print the ASC value of it returns 13, but deleting it has no effect (just removes characters before the blackbox symbol).
SECOND testAddRichText2
I tried adding italics to my text string in my working model, and then using it with the AddRichText method. AddRichText expects a range and I haven’t been able to convert the text string into a range.
Here is that code
Sub testAddRichText2()
Set oDoc = ActiveDocument
Dim LongTextrng As Range
For i = 1 To oDoc.Tables(2).Rows.Count
If oDoc.Tables(2).Rows(i).Cells(1).Range.Characters.Count > 1 Then
ShortText = oDoc.Tables(2).Cell(Row:=i, Column:=1)
ShortText = Left(ShortText, Len(ShortText) - 2)
longtext = oDoc.Tables(2).Cell(Row:=i, Column:=2).Range
longtext = Left(longtext, Len(longtext) - 2)
LongTextrng.Text = longtext 'Fails
LongTextrng.Italic = True
StatusBar = "Adding " & ShortText & " = " & longtextrng.Text
AutoCorrect.Entries.Add Name:=ShortText, Value:=LongTextrng
End If
Next i
MsgBox "done"
End Sub
Your first example, testAddRichText1, is almost correct. It fails because although you have recognised the need to remove the trailing characters from ShortText you haven't done the same for longText.
To shorten a range you move the end of the range using the MoveEnd method. In this instance you need to move the end of the range back one character to remove the end of cell marker.
In your second example, testAddRichText2, the code fails because you have not assigned the range to the variable, LongTextrng, correctly. When assigning a value to an object variable you need to use the Set command, like this:
Set objVar = object
This did not fail in your first attempt because LongText has not been declared and is therefore assumed to be a Variant.
The code below will work for you:
Sub AddRichTextAutoCorrectEntries()
Dim LongText As Range
Dim oRow As Row
Dim ShortText As String
For Each oRow In ActiveDocument.Tables(2).Rows
If oRow.Cells(1).Range.Characters.Count > 1 Then
ShortText = oRow.Cells(1).Range.Text
ShortText = Left(ShortText, Len(ShortText) - 2)
'assign the range to the variable
Set LongText = oRow.Cells(2).Range
'move the end of the range back by 1 character
LongText.MoveEnd wdCharacter, -1
StatusBar = "Adding " & ShortText & " = " & LongText.Text
AutoCorrect.Entries.AddRichText Name:=ShortText, Range:=LongText
End If
Next oRow
End Sub
I have a csv file which includes the html tags < b > and <\ b > to signify bold text. (I.e several words between these tags, in a longer block of text within the cell, should be bold). Is there a way using vba code in excel to strip the tags, and make the text between the tags bold?
Note - There are sometime multiple sets of tags within a given cell.
This should do what you want:
Sub BoldTags()
Dim X As Long, BoldOn As Boolean
BoldOn = False 'Default from start of cell is not to bold
For X = 1 To Len(ActiveCell.Text)
If UCase(Mid(ActiveCell.Text, X, 3)) = "<B>" Then
BoldOn = True
ActiveCell.Characters(X, 3).Delete
End If
If UCase(Mid(ActiveCell.Text, X, 4)) = "</B>" Then
BoldOn = False
ActiveCell.Characters(X, 4).Delete
End If
ActiveCell.Characters(X, 1).Font.Bold = BoldOn
Next
End Sub
Currently set to run on the activecell, you can just plop it in a loop to do a whole column. You can easily adapt this code for other HTML tags for Cell formatting (ie italic etc)
This was in the cell I tested on (minus the space after <): Sample < b>Te< /b>st of < B>bolding< /B> end
The result was: Sample Test of bolding end
Hope that helps