I have a question: i want to have an array of words of a WORD document, which are larger than 29 and Shorter than 40 characters. I implemented it in VBA this way:
Sub function()
Dim arr(1000) As String
counter = 0
For Each sentence In ActiveDocument.StoryRanges
For Each w In sentence.Words
If Len(w) > 28 And Len(w) < 40 Then
arr(counter) = w
counter = counter + 1
End If
Next
Next
End Sub
The Problem is that I want all words with char '_' cosidered as one word; for example: 'Adrian_link_mart' is one word and not 3: 'Adrian' and 'link' and 'mart' like it will be considered
thanks for your help, adrian
This may help. There is a bit of a wrinkle as you will see below.
Option explicit
Sub test()
' Use a collection rather than an array as we don't need
' to know the size in advance
Dim word_array As Collection
' Word doesn't actually have a 'word' object. Probably because
' that clashes with Word the application. So instead of Word.Word
' we are using word.range which gives us all the utility we will
' need
Dim my_word_range As Word.Range
Dim my_range As Word.Range
For Each my_range In ActiveDocument.StoryRanges
For Each my_word_range In my_range.Words
With my_word_range
Do While .Next(unit:=wdCharacter) = "_"
' '_' is considered to be a word by Word so we need to
' count two Word words to get to the end of the next
' text word IYSWIM
.MoveEnd unit:=wdWord, Count:=2
Loop
If .Characters.Count > 28 And .Characters.Count < 40 Then
word_array.Add Item:=.Text
End If
End With
Next
Next
End Sub
If you are new to VBA then
Include Option explicit at the top of every module
In the VBA IDE go Tools.Option.Editor.Code Settings and make sure every box is ticked.
Learn how to use F1. In the VBA IDE, putting the cursor on a keyword and pressing F1 will bring up the MS help page for that keyword
Is it possible to find words that MS-Word marks as errors?
My goal is to find words containing "è" instead of "é", but to use a macro I need to replace the char only into words marked as error.
I'm working on MS-Word 2013
here is some code to get you started. you need to add code that checks for the "bad" letter
' this is just demo code that shows how misspelled words could be replaced
' create document with a few words, one or two misspelled
' then single-step this code using F8 key
' while watching the text in the document
Sub aaaaaa()
Dim i As Integer
Dim badChr As String
Dim badWrd As String
Dim wrd As Object
For Each wrd In ActiveDocument.Words
If wrd.SpellingErrors.Count > 0 Then
badWrd = wrd.SpellingErrors(1).Text
Debug.Print badWrd
wrd.SpellingErrors(1).Text = string(len(badWrd),"x") ' replace whole word if you like
wrd.SpellingErrors(1).Text = badWrd ' put back original
For i = 1 To wrd.SpellingErrors(1).Characters.Count ' loop characters in misspelled word
badChr = wrd.SpellingErrors(1).Characters(i).Text
wrd.SpellingErrors(1).Characters(i).Text = "x" ' replace character
wrd.SpellingErrors(1).Characters(i).Text = badChr ' restore character
Next i
End If
Next wrd
End Sub
I'm writing a Microsoft Word VBA macro that runs through every paragraph of a word document and adds a comment to every paragraph. That comment contains the style for that paragraph. This way a coworker can print out the document with comments and know how to style similar documents in the future.
I'm almost there, the code adds the comments to every paragraph, but dies at the first row of a table:
"This method or property is not available because the object refers to the end of a table row."
Here is the code:
Sub aa_AddStylesComment()
'
' aa_AddStylesComment Macro
' Author: Me!
'
Dim strParaStyle As String
Dim cmtNewComment As Comment
'Run through word file and delete any comments with author set to a space character (that is the author of the comments added by the script)
For J = ActiveDocument.Comments.Count To 1 Step -1
With ActiveDocument
If .Comments(J).Author = " " Then
.Comments(J).Delete
End If
End With
Next J
'Running through every paragraph
For i = 1 To ActiveDocument.Paragraphs.Count
With ActiveDocument
'Get paragraph style
strParaStyle = .Paragraphs(i).Style
'Create a new comment and collect it - then change the author to space character
Set cmtNewComment = Selection.Comments.Add(.Range(.Paragraphs(i).Range.Words(1).Start, (.Paragraphs(i).Range.Words(1).End - 1)), strParaStyle)
cmtNewComment.Author = " "
End With
Next
End Sub
You can add a check if it is a table, and then if the paragraph has cells, as follows:
If .Paragraphs(i).Range.Tables.Count = 0 Then
Set cmtNewComment = .Paragraphs(i).Range.Comments.Add(.Range(.Paragraphs(i).Range.Words(1).Start, (.Paragraphs(i).Range.Words(1).End - 1)), strParaStyle)
cmtNewComment.Author = " "
ElseIf .Paragraphs(i).Range.Cells.Count > 0 Then
Set cmtNewComment = .Paragraphs(i).Range.Comments.Add(.Range(.Paragraphs(i).Range.Words(1).Start, (.Paragraphs(i).Range.Words(1).End - 1)), strParaStyle)
cmtNewComment.Author = " "
End If
Note that you don't need to use the Selection as you never change it.
Edit:
Spaces and tabs everywhere
Goal:
If there's 1 tab or less, check the next paragraph.
If there's 2 or more tabs, leave the first and delete the rest in that paragraph. Check next paragraph.
I want to leave the first paragraph marker so I can turn it into a table with the word in the first column, and the description/definition in the second column.
Attempted Method:
Look at each character in a paragraph and count the tabs. After counting tab characters, if there are more than the desired amount (currently one tab) then replace the first tab in the paragraph with a "^t" (tab character) and then any remaining tabs in that paragraph with "" (nothing, essentially deleting it).
Issues:
The script only sometimes works. It seems to get hung up when there are lines with less than 2 tabs per line.
The other times it'll delete the first tab in a line. The first occurrence should stay while the remainder leave.
The last line of my test word document sometimes isn't touched.
IF I run in repeatedly, it'll delete all tabs in the document except the last one in the last line.
Description:
I am an ugly coder, sorry. I'm self taught with loops, if/thens, and recording and modifying macros. This is not homework, it's so I don't have to manually go through 1,500 documents to format them since people use tabs to align text instead of the ruler bar. Pacman mode (show/hide non-printable characters mode) is very scary looking.
Sub TabFinder()
Dim oPara As Word.Paragraph 'paragraph
Dim var 'a counter for a FOR loop for finding tabs in a paragraph, represents a single character
Dim TabCounter As Long 'how many tabs will be in a paragraph
Dim oChar As Word.Characters 'characters in a paragraph
Dim StartHere As Long 'not currently used - thought I would try and save the location of the first tab to save it
Dim TabsFoundAndReplaced As Long 'how many times the program has replaced a tab in a line
Dim ReplaceText 'first tab will replace with a tab, 2nd and greater tab will be replaced with nothing
Dim ReplaceAmmount As Long 'counter for how many times tabs have been replaced per line
Dim TabsWantedPerLine As Long 'number of tabs we should keep in a line and not replace
TabsWantedPerLine = 1 'desired upper limit of tabs to stay in a line
Selection.HomeKey Unit:=wdStory 'go to the beginning of the document first for find feature
For Each oPara In ActiveDocument.Paragraphs 'for every paragraph in the document
TabCounter = 0
Set oChar = oPara.Range.Characters 'find the number of characters, and set oChar as the total
For var = 1 To oChar.Count 'for each character do the following
If oChar(var) <> "" Then 'stops an error
Select Case Asc(oChar(var)) 'stops an error
Case 9 '9 is tabs 'if there character oChar is a tab, then do the following
'If TabCounter = 0 Then StartHere = var 'not used currently, just a thought on how to save the tab with additional coding
TabCounter = TabCounter + 1 'counts tabs in the line
End Select
End If
Next
If TabCounter > TabsWantedPerLine Then 'if there are more tabs in a paragraph than upper limit, do the following (hopefully deleting any after the desired tabs
For ReplaceAmmount = 1 To TabCounter 'do this for each of the tabs in the paragraph
If ReplaceAmmount <= TabsWantedPerLine Then ReplaceText = "^t" Else ReplaceText = "" 'replaces the
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^t"
.Replacement.Text = ReplaceText 'replaces with a "^t" if first go around or "" if >1st go around
.Forward = True
.Wrap = wdFindStop
End With
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute replace:=wdReplaceOne
'.Find.Execute
Set oChar = oPara.Range.Characters 'since we have replaced some characters in the paragraph
End With
Next ReplaceAmmount
End If
Next 'for each oPara
End Sub
This code makes permanent changes to your data, so test it before using in real life.
This code seems to do what you want.
Sub TabFinder()
Dim i As Long
Const sFAKETAB As String = "|tab|"
For i = 1 To ThisDocument.Paragraphs.Count
'replace the first tab w a fake one
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, vbTab, sFAKETAB, 1, 1)
'replace all other tabs w nothing
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, vbTab, vbNullString)
'replace the fake tab w a real tab
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, sFAKETAB, vbTab)
Next i
End Sub
Here's the thing about using a For Each and changing the .Range.Text property: it doesn't work. It seems to reset which paragraph it's on. Kind of like when you delete something in a For Each loop and VBA loses track of where it is. So the above line are a little more verbose than 1) using For Each 2) using a With Block and/or 3) setting an object variable, but it works.
Update
Or you can replace the tabs with spaces, per Wayne's excellent comment.
Sub TabFinder3()
Dim i As Long
Dim j As Long
Const sFAKETAB As String = "|tab|"
Const lMAXTABS As Long = 5 'the maximum adjacent tabs you would have
For i = 1 To ThisDocument.Paragraphs.Count
'replace the first tab a fake one
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, vbTab, sFAKETAB, 1, 1)
'replace all other tabs w a space - multiple tabs replace wWith one space
For j = lMAXTABS To 1 Step -1
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, String(j, vbTab), Space(1))
Next j
'replace the fake tab w a real tab
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, sFAKETAB, vbTab)
Next i
End Sub
Let's try something like this which just uses some simple string functions.
First, iterate the paragraphs by index position (I couldn't make it work with a For Each oPara loop).
Capture each paragraph's text in a string variable: paraText
Use a Do ... Loop construct to replace the tabs with the string Replace function. The replacement text is assigned dynamically using the IIF function, which will use "^t" if TabCounter=1 or otherwise use the null string "". This loops until there are no tab characters in the string.
Once the paraText string has been thoroughly manipulated, simply assign that string to the oPara.Range.Text = paraText:
Option Explicit
Sub TabFinder()
Dim oPara As Word.Paragraph 'paragraph
Dim var 'a counter for a FOR loop for finding tabs in a paragraph, represents a single character
Dim TabCounter As Long 'how many tabs will be in a paragraph
Dim TabsWantedPerLine As Long 'number of tabs we should keep in a line and not replace
Dim paraText As String 'represents the string of each paragraph
TabsWantedPerLine = 1 'desired upper limit of tabs to stay in a line
Selection.HomeKey Unit:=wdStory 'go to the beginning of the document first for find feature
For var = 1 To ActiveDocument.Paragraphs.Count 'for every paragraph in the document
Set oPara = ActiveDocument.Paragraphs(var)
TabCounter = 0
paraText = oPara.Range.Text
'# Loop until there are no more tabs left to replace
Do Until InStr(paraText, Chr(9)) = 0
TabCounter = TabCounter + 1
'# replace tabs in our temporary string variable:
paraText = Replace(paraText, Chr(9), IIf(TabCounter = 1, "^t", vbNullString), , 1)
Loop
'# Assign our new string ot the paragraph range
oPara.Range.Text = paraText
Next var
End Sub
Updated from comments above
Backwards iteration over each character in paragraph, delete character IF it's a tab AND there is another tab somwhere to the left of it within the paragraph. This is functionally same as ensuring there is only one tab per paragraph, and only the first one should remain.
Example document:
Example output:
Here is the updated code. This would need more (probably a lot more) tweaking if you wanted to allow more than one tab per paragraph, but since the limit is 1, I think this works.
Note: This does not address indentation which Word recognizes distinctly from the paragraph's text.
Sub TabFinder()
Dim oPara As Word.Paragraph 'paragraph
Dim var 'a counter for a FOR loop for finding tabs in a paragraph, represents a single character
Dim i As Integer
Dim paraText As String 'represents the string of each paragraph
Selection.HomeKey Unit:=wdStory 'go to the beginning of the document first for find feature
LeaveFirstTab = False
For var = 1 To ActiveDocument.Paragraphs.Count 'for every paragraph in the document
Set oPara = ActiveDocument.Paragraphs(var)
For i = oPara.Range.Characters.Count To 1 Step -1
If Mid(oPara.Range.Text, i, 1) = Chr(9) Then
'As long as there's another tab to the left of this one, delete this one
If InStr(Left(oPara.Range.Text, i - 1), Chr(9)) > 1 Then
oPara.Range.Characters(i).Delete
End If
End If
Next
Next
End Sub
Updated to explain Mid() Function
The VBA Mid function takes a substring of specified length, starting at a specified position, from a string. Syntax is:
MID( string, start_position, number_of_characters )
So in the code above, we are taking the substring beggining at i (our character iterator) with a length of 1. This is basic way to iterate over characters in a string.
I just noticed though that there is a better/simpler way to do this with Word's object model. Instead of the Mid function, I think you can use oPara.Range.Characters(i) to return the same substring. I don't know why I didn't realize this earlier because we actually use that method two lines later when we do the .Delete!
So modified:
For i = oPara.Range.Characters.Count To 1 Step -1
If oPara.Range.Characters(i) = Chr(9) Then
'As long as there's another tab to the left of this one, delete this one
If InStr(Left(oPara.Range.Text, i - 1), Chr(9)) > 1 Then
oPara.Range.Characters(i).Delete
End If
End If
Next
i have a document that i'm reviewing with yellow highlighted text. i want a macro to go through and remove the lines that are highlighted. so far this is what i have:
Sub hilight()
'
' hilight Macro
' removes lines in yellow hi-lighter
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
Dim holder As String
If p.Range.Text = highlighted_text Then
p.Range.Text = holder
End If
Next p
End Sub
i need to know how highlighted text property is given so i can replace highlighted_text
Here is a solution. Note that it only replaces paragraphs in which the entire paragraph is yellow highlighted, not just part of it. There are a few things worth pointing out:
Replacing a paragraph will also take out the trailing line break, so I include it in the placeholder text
Since a line break is being added, if you don't loop through the paragraphs backwards, it'll be an infinite loop (thus the step -1)
Dim all variables outside of a loop
Sub ReplaceYellowParagrahps()
Dim p As Paragraph
Dim i As Long, count As Long
Dim placeholderText As String
placeholderText = "holder" & vblf
count = ActiveDocument.Paragraphs.count
For i = count To 1 Step -1
With ActiveDocument.Paragraphs(i).Range
If .HighlightColorIndex = wdYellow Then
.Text = placeholderText
End If
End With
Next
End Sub