I´m new to VBA and have to write a little Makro for work.
This Makro will be used to search for a Special set of symbols inside a Word Document.
So far I found a way to search for a string and mark it.
Yet it only functions with normal chars. The question is how to include symbols into the search.
My code so far is:
With Selection.Find
.ClearFormatting
.Text = "String"
.Execute Forward:=True
End With
The symbol-string needed to be found inside the document is: [•]
Thank You for Your Suggestions
Something as easy as this works for me:
Public Sub Testme()
With Selection.Find
.ClearFormatting
.Text = "•"
.Execute Forward:=True
End With
End Sub
If this is the bullet format and not a simple dot in a text, then you may use something like this to select the bulleted paragraph:
Sub FindBullet()
Dim rngTarget As Word.Range
Dim oPara As Word.Paragraph
Set rngTarget = Selection.Range
With rngTarget
Call .Collapse(wdCollapseEnd)
.End = ActiveDocument.Range.End
For Each oPara In .Paragraphs
If oPara.Range.ListFormat.ListType = _
WdListType.wdListBullet Then
oPara.Range.Select
Exit For
End If
Next
End With
End Sub
Source here.
Related
I'm facing a challenging request I need to solve using a VBA Macro in Word.
The document is a template that will grab some data in a DB upon generation. It contains multiple tables but I don't know how many and how many data will be in each table.
It looks like this:
Sample initial state
The requirement is to be able to detect the strings that are not followed by a table and delete them.
Said differently when a string is followed by the table, it's all good. When a string is followed by another string, it should be deleted.
The different strings are known, I'm guessing this would help.
After the macro run, my previous sample should look like this:
Sample expected result
I know it looks bit harsh but I don't even know where to start :(
I've looked at macro searching for a text but I wasn't able to find something like
IF stringA is followed by a table then do nothing if not then delete.
Any help of the community would be very much appreciated!
Thanks
Julien
This should get you started:
Sub FindAndDelete()
Dim rng As Range
Set rng = ActiveDocument.Content
With rng
With .Find
.ClearFormatting
.Text = "Text to find"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
.Next(wdParagraph).Delete
End If
Loop
End With
End Sub
Thank you so much!
I was able to make it work by slightly modifying it as the proposed code was deleting the string followed by the table:
Dim rng As Range
Set rng = ActiveDocument.Content
With rng
With .Find
.ClearFormatting
.Text = "This is my table C"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
.Delete
End If
Loop
End With
my last step is to make the macro run only for a specific part of the document. I guess I need to work on the range. I'll give a try and post the result here.
Again thank you for helping pure newbies!
So I had it working using the below code. I slightly modify the "while" loop so that it deletes the entire row rahter than just the word
Sub HeaderDelete()
'
' HeaderDelete Macro
'
Dim rng As Range
Set rng = ActiveDocument.Content
With rng
With .Find
.ClearFormatting
.Text = "This is my table A"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
Selection.HomeKey wdLine
Selection.EndKey wdLine, wdExtend
Selection.Delete
End If
Loop
With .Find
.ClearFormatting
.Text = "This is my table B"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
Selection.HomeKey wdLine
SelectionS.EndKey wdLine, wdExtend
Selection.Delete
End If
Loop
With .Find
.ClearFormatting
.Text = "This is my table C"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
Selection.HomeKey wdLine
SelectionS.EndKey wdLine, wdExtend
Selection.Delete
End If
Loop
End With
End Sub
The challenge is I have 50+ "this is my table X" and they may possibly change overtime...
I tried to find a solution which wouldn't be used on the ".Find" but more on "if there is a row not followed by a table then delete" but I wasn't successful so far.
On a side note I wanted to remove the table borders of all my tables and I found the below which works great!
Dim doc As Document
Dim tbl As Table
Set doc = ActiveDocument
For Each tbl In doc.Tables
With tbl.Borders
.InsideLineStyle = wdLineStyleNone
.OutsideLineStyle = wdLineStyleNone
End With
Next
Again, thanks a lot for helping VBA newbies!
I'd like to find several strings within Word document and for each string found, I like to print (debug.print for example) the whole row content where the string is found, not the paragraph.
How can I do this? Thanks
Sub FindStrings
Dim StringsArr (1 to 3)
StringsArr = Array("string1","string2","string3")
For i=1 to 3
With
Selection.Find
.ClearFormatting
.Text = Strings(i)
Debug.Print CurrentRow 'here I need help
End With
Next
End Sub
The term Row in Word is used only in the context of a table. I assume the term you mean is Line, as in a line of text.
The Word object model has no concept of "line" (or "page") due to the dynamic layout algorithm: anything the user does, even changing the printer, could change where a line or a page breaks over. Since these things are dynamic, there's no object.
The only context where "line" can be used is in connection with a Selection. For example, it's possible to extend a Selection to the start and/or end of a line. Incorporating this into the code in the question it would look something like:
Sub FindStrings()
Dim StringsArr As Variant
Dim bFound As Boolean
Dim rng As Word.Range
Set rng = ActiveDocument.content
StringsArr = Array("string1", "string2", "string3")
For i = LBound(StringsArr) To UBound(StringsArr)
With rng.Find
.ClearFormatting
.Text = StringsArr(i)
.Wrap = wdFindStop
bFound = .Execute
'extend the selection to the start and end of the current line
Do While bFound
rng.Select
Selection.MoveStart wdLine, -1
Selection.MoveEnd wdLine, 1
Debug.Print Selection.Text
rng.Collapse wdCollapseEnd
bFound = .Execute
Loop
End With
Set rng = ActiveDocument.content
Next
End Sub
Notes
Since it's easier to control when having to loop numerous times, a Range object is used as the basic search object, rather than Selection. The found Range is only selected for the purpose of getting the entire line as these "Move" methods for lines only work on a Selection.
Before the loop can continue, the Range (or, if we were working with a selection, the selection) needs to be "collapsed" so that the code does not search and find the same instance of the search term, again. (This is also the reason for Wrap = wdFindStop).
I noticed this line of code elsewhere:
If rng1.Find.Execute(FindText:="Title") Then
I have looked, yet find no readily accessible guidance on the following, which is my question:
What do I need to do to the above line of code in order to cause it to look only for Title and not Title?
Here's a basic example:
Sub Tester()
Dim rng As Range
Set rng = ActiveDocument.Content
With rng.Find
.ClearFormatting 'clear any existing format settings
.Font.Bold = True 'looking for Bold text only
If .Execute(FindText:="Title") Then
Debug.Print "found it!"
rng.Select 'rng is now the found text...
End If
End With
End Sub
For most of the documents I work with, I need to highlight instances of Asian font (such as SimSun, MS Mincho).
I put together the the code below - it works well but it doesn't highlight Asian font characters within non-Asian words (such as the apostrophe in "it's").
Sub HighlightAsian2019()
Dim aWord
For Each aWord In ActiveDocument.Words
If aWord.Font.Name = "SimSun" Then
aWord.FormattedText.HighlightColorIndex = wdTurquoise
End If
Next aWord
For Each aWord In ActiveDocument.Words
If aWord.Font.Name = "MS Mincho" Then
aWord.FormattedText.HighlightColorIndex = wdTurquoise
End If
Next aWord
End Sub
Can anyone help me improve the code so that ALL instances of SimSun and MS Mincho in the text are highlighted?
Any help will be greatly appreciated!
Use this Loop:
Sub HighlightAsian2019()
With ActiveDocument.Range
For i = 1 To .Characters.Count
If .Characters(i).Font.Name = "SimSun" Then
.Characters(i).FormattedText.HighlightColorIndex = wdTurquoise
End If
Next
End With
End Sub
You can use the .Characters property of Range to access the alphabets. Add another If condition for other fonts to check
Since I don't have that particular font, I tested with other fonts, may try with modifying the font names.
Sub test()
Dim Rng As Range
Set Rng = ThisDocument.Content
With Rng.Find
.ClearFormatting
.Text = ""
.Font.Name = "Kruti Dev 040 Wide"
Do While .Execute
Rng.FormattedText.HighlightColorIndex = wdTurquoise
Loop
End With
End Sub
Sorry for the fundamental question but I am a LONGtime Access VBA developer who is getting my butt kicked by Word.
I am building a solution for someone who uses a Legal Case Management System with a specific numbering scheme (aaa-aaa-##-##-###). I need to search a document for hyphens and then grab the whole paragraph where a hyphen is found. I then need to send the text from that paragraph to a separate function which parses out the file number from the paragraph (this function already works).
If that function is successful, it returns the File Number, otherwise it returns "NOT FOUND". So, I need to:
Find all hyphens
Capture the paragraph with a hyphen
Pass that text to the function
GO TO THE NEXT HYPHEN IF function returns "NOT FOUND"
I have tried dozens of options without success. I typically get stuck in an infinite loop (and do not seem to move forward) or I get to the end of the process with a false failure.
I do not know how to move to the NEXT occurrence of a hyphen and repeat the process. I also do not know how to run the process to the end of the document or stop at the end (without starting all over - because the hyphens REMAIN since this is NOT a replace process).
I have tried so many different versions, but I included one below.
Thanks for any guidance. I do appreciate it.
DGP
Public Sub TestFind77() '
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Text = "-"
.Execute Forward:=True
Do While .Found = True
.Parent.Expand Unit:=wdParagraph
Dim strWTF As String
strWTF = .Parent
'MsgBox strWTF
strResult = fnGetFileNumberFromString(strWTF) ' This works
If strResult <> "NOT FOUND" Then
GoTo success
End If
.Execute Forward:=True
Loop
End With
success:
MsgBox strResult
End Sub
I understand... Good start and you're missing only tiny pieces.
One thing you need is Word's Range object. Best to use that with Find - unlike Selection you can work with multiple Ranges in your code.
Sometimes, when working with Find it's necessary to refer back to the original Range (the entire document, in your case). That doesn't appear to be the case, here, but I've built it in, anyway, on general principle - so you have it if it turns out you need it.
I've found it more reliable to save the result of Find.Execute in a boolean variable, rather than relying on .Found, so I've put that in, as well.
You can pick up the paragraph in which the Range is located using Range.Paragraphs(1). I tried to stick to what you have, but if you want to tighten up your code even more, you could do this as long as you don't need the paragraph for anything else:
strWTF = rngSearch.Paragraphs(1).Range.Text
Good luck!
Public Sub TestFind77()
Dim rngDoc as Word.Range
Dim rngSearch as Word.Range
Dim bFound as boolean
Dim para as Word.Paragraph
Set rngDoc = ActiveDocument.Range
Set rngSearch = rngDoc.Duplicate
With rngSearch.Find
.ClearFormatting
.Text = "-"
bFound = .Execute(Forward:=True)
Do While bFound = True
Set para = rngSearch.Paragraphs(1)
Dim strWTF As String
strWTF = para.Range.Text '???.Parent
'MsgBox strWTF
strResult = fnGetFileNumberFromString(strWTF) ' This works
If strResult <> "NOT FOUND" Then
GoTo success
End If
rngSearch.Collapse wdCollapseEnd 'search from after the found to the end of the doc
bFound = .Execute(Forward:=True)
Loop
End With
success:
MsgBox strResult
End Sub
Thanks Cindy,
I am still not sure that I understand the Word Object Model well enough to understand why...but your answer got it to work.
I did incorporate your suggestion re
strWTF = rngSearch.Paragraphs(1).Range.Text
Here is the final code, including that input:
Public Sub TestFind99()
Dim rngDoc As Word.Range
Dim rngSearch As Word.Range
Dim bFound As Boolean
Dim strWTF As String
Set rngDoc = ActiveDocument.Range
Set rngSearch = rngDoc.Duplicate
With rngSearch.Find
.ClearFormatting
.Text = "-"
bFound = .Execute(Forward:=True)
Do While bFound = True
strWTF = rngSearch.Paragraphs(1).Range.Text
strResult = fnGetFileNumberFromString(strWTF) ' This works
If strResult <> "NOT FOUND" Then
GoTo success
End If
rngSearch.Collapse wdCollapseEnd 'search from after the found to the end of the doc
bFound = .Execute(Forward:=True)
Loop
End With
success:
MsgBox strResult
End Sub