I would like to delete certain lines from my word document using a VBA macro. Basically the (block of) text to be deleted (and replaced by "***") follows a certain pattern (below).
Bottom of Form
perma-link
Top of Form
save
Bottom of Form
[+] ....
[–] ....
Top of Form
"...." represents text that changes every block, but for sure the line starts with "[+]" or "[-]".
Please suggest a suitable macro
EDIT: In the screenshot, I would like to keep the text in yellow and delete the rest. (in the actual file, the text isn't in yellow)
PS-FYI, I tried using the example looping a find and delete row macro (for line by line deletion) but i get a runtime error 5941 with debugging option highlighting the line "selection.row.delete" in the macro.
What does this mean?
Assuming that the example list is a list of paragraphs beginnings the following code should do the trick. What you have to do is to place all 'paragraphs starting' into array arrRemove as I did for the test. If any of the mark is a special marks (see this link for additional information) you need to add \ in front of it as I did for [+] and [-]. Hope this is what you are looking for.
Sub Macro2()
Dim arrRemove As Variant
arrRemove = Array("Bottom of Form", "perma -link", "Top of Form", _
"\[+\]", "\[\-\]", "Donec", "In")
Dim i!
For i = 0 To UBound(arrRemove)
Activedocument.Range(0,0).select
Selection.Find.ClearFormatting
With Selection.Find
.Text = arrRemove(i) & "*^13"
.Replacement.Text = "" 'replace with nothing
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next i
End Sub
The above macro will remove all yellow paragraph in the following document.
Related
I am trying to find a selection of text in a Word document and then lock the content control.
I have one search text 'Our Ref:' and another 'Your Ref:'.
When the second sub searches for 'Our Ref:' it also highlights 'Your Ref:'.
Screenshot of search result for 'our ref:'
I tried to add .MatchPrefix which works within the advanced find in Word, but not in the macro.
Is there a way to either skip the first result or narrow the search?
Private Sub LockOurRef()
With Selection.find
.Text = "Our Ref:"
.MatchWholeWord = True
.Forward = True
.Execute
Selection.Range.ContentControls.Add (wdContentControlGroup)
Selection.ParentContentControl.LockContentControl = True
End With
End Sub
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.
I am executing a style search in Microsoft Word using a VBA Macro.
My goal is to perform certain actions once for every style found in the document.
The macro works correctly on documents that have at least two paragraphs, but the macro does not alert the style correctly in a document that has exactly one paragraph in it. It seems strange that when I enter a new paragraph mark, the styles are found, even though I did not add any new text or styles to the document, just an extra blank paragraph mark. Does anyone know what is wrong with my macro and how I can fix this? Thanks for taking a look.
Sub AlertAllStylesInDoc()
Dim Ind As Integer
Dim numberOfDocumentStyles As Integer
Dim styl As String
Dim StyleFound As Boolean
numberOfDocumentStyles = ActiveDocument.styles.count
For Ind = 1 To numberOfDocumentStyles
styl = ActiveDocument.styles(Ind).NameLocal
With ActiveDocument.Content.Find
.ClearFormatting
.text = ""
.Forward = True
.Format = True
.Style = styl
Do
StyleFound = .Execute
If StyleFound = True Then
' actual code does more than alert, but keeping it simple here'
MsgBox styl
GoTo NextStyle
Else
Exit Do
End If
Loop
End With
NextStyle:
Next
End Sub
I don't understand why ActiveDocument.Content is not working, but replacing it with ActiveDocument.Range(0,0) appears to resolve the issue (tested in Word 2016).
With ActiveDocument.Range(0, 0).Find
I'm trying to write a macro that displays a popup when a user clicks save (I have it as Sub FileSave() ) if the document contains any highlighting. So far, everything works great with the message box. Unfortunately I can't figure out which conditions to use for the if statement to check whether the document contains highlighting or not.
Can anyone help me with a few lines of VBA for this?
You simply need to search for highlighted text within document content in this way:
Sub SearchAnyHighlight()
Dim hiliRng As Range
Set hiliRng = ActiveDocument.Content
With hiliRng.Find
.Highlight = True
.Execute
End With
If hiliRng.Find.Found Then
'to inform that something was found
MsgBox "You can't close Active Document"
'to remove all highlighted area <-- added after edition
With hiliRng.Find
.Replacement.Highlight = False
.Execute "", Replace:=wdReplaceAll, Forward:=True, _
ReplaceWith:="", Format:=True
End With
End If
End Sub
I have a document with many acronyms that need to be captured and put into an acronyms table at the end of the document.
The term acronym has various meanings. I'd like to create a table that has all of the words that are initialized; two or more capitalized letters that are short for a longer meaning. I.e., CD-ROM, USB, SYNC, MMR, ASCAP, etc.
How do I create a macro to do this?
Something like this might get you started. Add a reference to "Microsoft VBScript Regular Expressions" (Edit Macro: Tools > References). This library is the file, "vbscript.dll".
You may need to adjust the regexp if all your acronyms aren't only upper-case letters (eg some may contain numbers).
Sub Acronyms()
Dim dict, k, tmp
Dim regEx, Match, Matches
Dim rngRange As Range
Set regEx = New RegExp
Set dict = CreateObject("scripting.dictionary")
regEx.Pattern = "[A-Z]{2,}" '2 or more upper-case letters
regEx.IgnoreCase = False
regEx.Global = True
Set Matches = regEx.Execute(ActiveDocument.Range.Text)
For Each Match In Matches
tmp = Match.Value
If Not dict.Exists(tmp) Then dict.Add tmp, 0
dict(tmp) = dict(tmp) + 1
Next
For Each k In dict.Keys
Debug.Print k, dict(k)
Next k
End Sub
Thanks Tim, your code works great!
If it will be of any use to others, the pattern [A-Z]{1,}([a-z]*|\&|\.*)[A-Z]{1,} will find more acronyms...
(I do not have permission to post comments, hence adding this as answer)
Edit (still no way to add comments): \b[A-Z]{1,}([a-z*]|\&|\.|\-)[A-Z]{1,}\b is more robust, but will fail if the last character of the acronym is not capitalized.
I have found the following works well (where some business name acronyms are tolerable). I use this to test data entries in Access, it should also work for a Word document range.
objRegExp.Pattern = "([A-Z]{1,}((\&(?![A-Z]\s[\w]{3})\w*)+|\.\w*)+)|[A-Z]{2,}(?![A-Z]*\s[A-Z]{1}[a-z])"
J&K =Match
JK&S =Match
J.S.S =Match
JK&S.K =Match
JSK =Match
JK =Match
DKD And Sons =No Match
J&K Engineering =No Match
PKF Rogers and Associates =No Match
I use RegExHero to test my expressions
I used the following to find abbreviations in my PhD thesis. They were all in "()".
regEx.Pattern = "\([A-Z]{1,}([a-z]*|\&|\.|\-*)[A-Z]{1,}\)"
You will be running a macro on the main Word document. Open a separate Word document that is blank. This will be used to store discovered the acronyms.
Press "Record Macro". Choose a unique name, and assign a shortcut key such
as CTRL + ALT + A.
Open the Find dialogue (CTRL + F). Paste the following search text:
<[A-Z]{2,}>. In the Find dialogue, choose "More" > check the box for "Use Wildcards". Click the Find Next button.
Right-click on the selected text, being careful not to change the
highlight. Select Copy from the context menu.
Navigate to the separate Word document (ALT + TAB, select the Word
document). Paste the copied text, and hit Enter. ALT + TAB back to
the original Word document.
Close the find dialogue and click the right arrow once. This moves
the cursor off the highlighted text, and readies it for the next
search.
Stop the macro recording.
You now have a macro that finds a word containing two or more capitalized letters, and saves the text to a separate document. In order to search for the remaining acronyms, press CTRL + ALT + A continuously until the end of the document has been reached. Or, edit the macro, and add while a loop.
Here is what the macro looks like (without the loop):
Sub GetAcronyms()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<[A-Z]{2,}>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.Copy
Windows("Document1.docx").Activate
Selection.PasteAndFormat (wdPasteDefault)
Selection.TypeParagraph
Windows("TheOriginalDocument.docx").Activate
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub