I often use a legacy text editor (Vim) to take meeting notes because I can keep up with the talking. However, most people (including myself) prefer the final notes to be in Word, with bullets and sub-bullets. Here is an example of a text file that I wanted to convert to Word bullets:
Meeting notes
-------------
* The quick brown fox
* The quick brown fox
- Jumped over the lazy dogs
- Jumped over the lazy dogs
* The quick brown fox
I recorded a macro to convert text bullets to Word bullets. Any paragraph starting with text bullet "*" gets converted to "List Bullet 2", then I globally replace "*" with "" (i.e., deleted). Any paragraph starting with the more indented text bullet " -" gets converted to "List Bullet 4", then I globally delete " -". The "BulletsTxt2wrd" macro is shown below.
The problem is, I use Word's Find/Replace function, which can't really restrict the search of the above strings to the beginning of a paragraph. If there is a "*" in the middle of the paragraph (perhaps "25 * 3.1415"), the same paragraph formatting and deletion occurs.
Regular expressions can confine searches to the start of a paragraph. I used regular expressions in a unix environment, and after years of reading that it can be done in VBA, I used it in simple Excel function to convert time durations specified in days/minutes to hours. For example (see "DurtnStr2hrs" function below:
"20 hours" becomes 20
"1 hour" becomes 1
"1 day" becomes 24
"3 days" becomes 3*24
"1 minute" becomes 1/60
"70 minutes" becomes 70/60
I use this function within a spreadsheet cell, with the argument being another cell containing the string to be converted.
Is there a way to use the regular expression package and objects in the "BulletsTxt2wrd" Word macro? It seems to function like a black box, and the VBA code doesn't really expose the object property containing the string that I want to operate on.
P.S. This post doesn't deal with the Find/Replace method that I recorded, which goes through the entire document to locate matches.
This post refers to VBScript, but I really would like to avoid having to figure out another language to accomplish my simple task.
This post also doesn't use the Find/Replace recorded in my macro.
Sub BulletsTxt2wrd()
'
' BulletsTxt2wrd Macro
'
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("List Bullet 2")
With Selection.Find
.Text = " * "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " * "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("List Bullet 4")
With Selection.Find
.Text = " - "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " - "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Function DurtnStr2hrs(str) As Double
' Use for DurtnHrs column
Dim NewStr As String
Dim regex1 As Object
Set regex1 = New RegExp
NewStr = str
regex1.Pattern = " hours?"
NewStr = regex1.Replace(NewStr, "")
regex1.Pattern = " minutes?"
NewStr = regex1.Replace(NewStr, "/60")
regex1.Pattern = " days?"
NewStr = regex1.Replace(NewStr, "*24")
DurtnStr2hrs = Evaluate(NewStr)
End Function
«The problem is, I use Word's Find/Replace function, which can't really restrict the search of the above strings to the beginning of a paragraph» Au contraire, you could use:
Sub Demo1()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^13[ *-]{1,}"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
.Start = .Start + 1
Select Case Trim(.Text)
Case "*": .Paragraphs.Last.Style = wdStyleListBullet2
Case "-": .Paragraphs.Last.Style = wdStyleListBullet4
End Select
.Text = vbNullString
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
As for the DurtnStr2hrs conversion, I note there remains a disconnect between your text description of ""20 hours" becomes 20*60" and your Regex of "NewStr = regex1.Replace(NewStr, "/60")". That said, try:
Sub Demo2()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<[0-9]# [dh][ao][yu]*>"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
.Start = .Start + 1
Select Case Split(.Text, " ")(1)
Case "hour": .Text = Split(.Text, " ")(0)
Case "hours": .Text = Split(.Text, " ")(0) & "/60"
Case "day": .Text = "24"
Case "days": .Text = Split(.Text, " ")(0) & "*24"
End Select
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
The following seems to do the job:
Sub BulletTxt2doc()
doL1bullet:
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p * "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute
If .Found = True Then
Selection.EndKey Unit:=wdLine
Selection.Style = ActiveDocument.Styles("List Bullet 2")
Selection.MoveUp Unit:=wdParagraph, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
GoTo doL1bullet
End If
End With
doL2bullet:
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p - "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute
If .Found = True Then
Selection.EndKey Unit:=wdLine
Selection.Style = ActiveDocument.Styles("List Bullet 4")
Selection.MoveUp Unit:=wdParagraph, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
GoTo doL2bullet
End If
End With
End Sub
Related
I'm trying to select any bolded & underlined text in a paragraph (in Microsoft word 2016). I really just want to select the text so I can manipulate in various ways (which will constantly vary depending on my needs for that specific text), eg highlight, unbold, copy etc.
I created the below macro using the macro recorder feature and when I was doing it it worked perfectly. But when I subsequently ran the macro it highlighted the whole paragraph, as opposed to just the bolded & underlined parts.
Sub SelectBoldandUnderlineCurrentParagraph()
'
' SelectBoldandUnderlineCurrentParagraph Macro
'
'
Selection.MoveUp Unit:=wdParagraph, Count:=1
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.Find.ClearFormatting
With Selection.Find.Font
.Bold = True
.Underline = wdUnderlineSingle
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End Sub
Try:
Sub Demo()
With Selection.Paragraphs.First.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.Text = ""
.Replacement.Text = ""
.Format = True
.Forward = True
.Wrap = wdFindStop
.Execute
End With
.Select
End With
End Sub
I am trying to figure a way to convert intext notes (notes and references within the text body) to endnotes in an MS Word document that has existing endnotes and this is my first macro in decades.
My intext notes can be identified since they are in dark blue between curled brackets. So far I managed to record a macro for the single steps: Search for pattern, cut pattern, insert endnote, paste pattern, search pattern again in endnotes, remove curled brackets, focus back to the beginning of the document (out of endnotes).
Here is how it looks:
Sub inline2endnote()
Selection.Find.ClearFormatting
Selection.Find.Font.Color = 6299648
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\{(*?)\}"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.Cut
With Selection
With .EndnoteOptions
.Location = wdEndOfDocument
.NumberingRule = wdRestartContinuous
.StartingNumber = 1
.NumberStyle = wdNoteNumberStyleArabic
End With
.Endnotes.Add Range:=Selection.Range, Reference:=""
End With
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.Find.ClearFormatting
Selection.Find.Font.Color = 6299648
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\{(*?)\}"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
Selection.HomeKey Unit:=wdStory
End Sub
I had to focus back on top because I needed to exit the endnotes section and go back to body text. Also, I have no idea what the last "With" section is meant to do.
Now I would like to loop this pattern in order to fix all the inline notes, but I seem unable to find away. I was using this thread as a reference but I can't figure out how to properly set my scope and define the fields for my iterations.
I was also wondering if there is a cleaner way to write the steps, like pasting my content without curled brackets directly, like store my find in a variable and use a second one with stripped content.
Try:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, E_Nt As Endnote
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "\{[!\{]#\}"
.Font.Color = 6299648
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
Set Rng = .Duplicate
With Rng
.Start = .Start + 1
.End = .End - 1
End With
Set E_Nt = .Endnotes.Add(.Duplicate)
E_Nt.Range.FormattedText = Rng.FormattedText
E_Nt.Range.Font.ColorIndex = wdAuto
.Text = vbNullString
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
I am using the following code to bold parts of a text string, in this case where the word 'Fish' is in brackets after the word 'Oil':
Sub ReplaceAndFormat16()
Dim sConst1 As String, sReplaceMent As String
Dim rRange As Range, rFormat As Range
sConst1 = "Fish"
sReplaceMent = "Oil (" & sConst1 & ")"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Oil (Fish)"
.Replacement.Text = sReplaceMent
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceOne
If .Found Then
Set rRange = Selection.Range
Set rFormat = ActiveDocument.Range(rRange.Start + 5, rRange.Start + 5 + VBA.Len(sConst1))
rFormat.Font.Bold = True
End If
End With
End Sub
This code works perfectly, but only bolds the first instance, and my documents may have up to four instances of this phrase that need to be formatted bold.
How do I amend the code so it carries on and bolds all instances in the document? I am very new to VBA, so apologies if this seems like a stupid question.
Change the line
.Execute Replace:=wdReplaceOne
to
.execute Replace:=wdReplaceAll
Edit
OK the above was a stupid response. The code below does the right thing
Sub ReplaceAndFormat16()
Const myFindStr As String = "Oil (Fish)"
Dim myFindRange As Word.Range
Set myFindRange = ActiveDocument.StoryRanges(wdMainTextStory)
Do
With myFindRange.Find
.ClearFormatting
.Text = myFindStr
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found Then
With myFindRange
.MoveStartUntil cset:="fF"
.MoveEndUntil cset:="hH", Count:=wdBackward
.Font.Bold = True
.Collapse Direction:=wdCollapseEnd
End With
Else
Exit Sub
End If
End With
Loop
End Sub
I have an MS Word document including a table. I am trying to find and replace text via VBA using the following code:
If TextBox1.Text <> "" Then
Options.DefaultHighlightColorIndex = wdNoHighlight
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "<Customer_Name>"
.Replacement.Text = TextBox1.Text
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.ClearFormatting
With Selection.Find.Font
.Italic = True
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Italic = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End If
This works fine for replacing all my content which is outside of the table. But it will not replace any of the content within the table.
If your goal is to perform replacements in the whole documents (it looks so from the code, but it is not explicit), I would suggest you use Document.Range instead of the Selection object. Using Document.Range will make sure everything is replaced, even inside tables.
Also, it is more transparent to the user, as the cursor (or selection) is not moved by the macro.
Sub Test()
If TextBox1.Text <> "" Then
Options.DefaultHighlightColorIndex = wdNoHighlight
With ActiveDocument.Range.Find
.Text = "<Customer_Name>"
.Replacement.Text = TextBox1.Text
.Replacement.ClearFormatting
.Replacement.Font.Italic = False
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End If
End Sub
I have used the following code and it works like charm..... for all the occurances that are found in the document.
stringReplaced = stringReplaced + "string to be searched"
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "string to be searched"
.Replacement.Text = "string to be replaced"
.Wrap = wdFindContinue
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = False
.Execute Replace:=wdReplaceAll
End With
Next myStoryRange
I'm trying to do the following using the macro:
Upon opening the document, automatically search whole document for brackets {{ }} and delete them including the text inside.
It doesn't do the job well, just operates on the text selected, not the whole document.
Sub SelectToBracketsDelete()
With Selection.Find
.ClearFormatting
.Text = "{{"
.Forward = False
.Wrap = wdFindStop
.Execute
End With
Selection.Extend
With Selection.Find
.Text = "}}"
.Forward = True
.Execute
.Text = ""
End With
Selection.Text = ""
End Sub
Is this what you are looking for?
Word 2007 -> stackoverflow
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\{\{*\}\}"
.Replacement.Text = ""
.Forward = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll