I have the following piece of code (not mine) which adds a tab to every footnote in MS Word (2013).
The code works fine, but it would work even better if it didn't add a tab each time but it would simply replace first character (whatever it would be - tab, space) with a tab.
That way if the macro is run twice I didn't have two tabs, etc.
Sub TabFootnotes()
For s = 1 To ActiveDocument.Footnotes.Count
ActiveDocument.Footnotes(s).Range.Select
With Selection
.Collapse Direction:=wdCollapseStart
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
.TypeText Text:=vbTab
End With
Next
End Sub
However you do this, you will have to come up with a way to determine if the first character is replaceable or not. This is because when you change that space to something else, this something becomes a part of the footnote's Range. So when the macro is run another time, you'll need to know if you must keep or replace the first character.
Dim f As Footnote
For Each f In ActiveDocument.Footnotes
With f.Range.Characters(1)
If .Text = vbTab Or .Text = " " Then 'Use any other sensible detection logic here
.Text = vbTab
Else
.InsertBefore vbTab
End If
End With
Next
Related
I have a word document that is a transcription of an interview. The moderators comments are in bold and respondents comments are not bold. It is a long continuous run on of bold and un-bold text. I need to add a carriage return so that there is a blank line between the moderator and the respondents questions. I found the code below to insert a carriage return between specific text, but I don't know how to change it to insert between bold and un-bold text. Any help is greatly appreciated!
Sub Test()
ActiveDocument.Paragraphs(1).Range.Text = "Foo" & Chr(11) & "Bar"
End Sub
This is what I came up with, it uses one sub to insert a break after bold text, and then calls another sub to do the same for nonbold text. I used the constant 'vbCrLf' which stands for Visual Basic Carriage Return Line Feed, it's equal to Chr(13) + Chr(10), and I believe it's the best practice for compatibility when inserting a line break in a document as opposed to Chr(11).
Sub InsertBreakAfterBold()
'Select entire document
Selection.WholeStory
'Make each .Method belong to Selection.Find for readability
With Selection.Find
'Set search criteria for bold font
.Font.Bold = True
'Find next occurrence
.Execute
'Each time bold text is found add a line break to the end of it then find the next one
Do While .Found
Selection.Text = Selection.Text + vbCrLf
.Execute
Loop
End With
'Repeat process for nonbold text
Call InsertBreakAfterNonbold
End Sub
Sub InsertBreakAfterNonbold()
Selection.WholeStory
With Selection.Find
.Font.Bold = False
.Execute
Do While .Found
Selection.Text = Selection.Text + vbCrLf
.Execute
Loop
End With
End Sub
Microsoft's VBA reference was my biggest resource to make this: https://learn.microsoft.com/en-us/office/vba/api/overview/word
I have a simple loop (below) that looks for sentences over 30 words long. If found, it adds a comment box to the selected sentence. It worked fine in testing. Then I added some test endnote citations...and it fails to find the long sentences.
However, it only fails when there is no space between the period and the citation superscript. If I add a space, it finds it and works perfectly. The problem is, there is not suposed to be a space between the period and the citation, per the style guide I have to follow at work.
This related Stack thread discusses the need for a space after a period to delineate the end of a sentence. I am assuming the space must be directly after the period, because I have spaces in my citations like this 1, 2, 3
Question
How can I find instances of period+superscript (with no space like this --> This is a sentence.1, 2, 3) and add a space? Ideally I would like this to happen within the below loop so I can remove the space after the comment gets added.
Sub Comment_on_Long_Sentences ()
Dim iWords as Integer
iWords = 0
For Each MySent in ActiveDocument.Sentences
If MySent.Words.Count > iWords Then
MySent.Select
'find and delete space
ActiveDocument.Comments.Add Range:= Selection.Range, Text:= "Long Sentence: " & iWords & " words"
'put the space back
End if
Next MySent
End Sub
There appears to be issues in VBA when trying to access Sentences that end with a superscript character. Your code also has problems with non-declared variables, so I have no idea how it ever worked for you in the first place.
Try this following VBA routine, it works in my environment. Also notice the special handling that I found is required for 1st sentences in paragraphs and when that sentence ends with a superscript character.
Sub Comment_on_Long_Sentences()
Dim doc As word.Document, rng As word.Range, para As word.Paragraph
Dim i As Long
Set doc = ActiveDocument
For Each para In doc.Paragraphs
Debug.Print para.Range.Sentences.Count
For i = 1 To para.Range.Sentences.Count
Set rng = para.Range.Sentences(i)
If i = 1 And rng.Characters.First.Font.Superscript = True Then
rng.MoveStart word.WdUnits.wdSentence, Count:=-1
End If
If rng.words.Count > 30 Then
doc.Comments.Add Range:=rng, Text:="Long Sentence: " & rng.words.Count & " words"
End If
Next
Next
End Sub
Here is an alternative solution. Note the option explicit at the start. Its good VBA practice to put this at the top of every module.
The problem you have is very common. Find something then rather than do a replace, do some other non replace related stuff. The subs to add and remove spaces before citations implement this pattern and are well worth studying.
If you don't understand anything then in the VBA IDE just put your cursor on the relevant keyword and press F1. This will bring up the relevant MS help page.
Option explicit
Sub Comment_on_Long_Sentences()
Dim iWords As Integer
Dim my_sentence As Variant
iWords = 30
AddSpaceBeforeCitations
For Each my_sentence In ActiveDocument.Sentences
If my_sentence.Words.Count > iWords Then
my_sentence.Comments.Add Range:=my_sentence, Text:="Long Sentence: " & iWords & " words"
End If
Next my_sentence
RemoveSpaceBeforeCitations
End Sub
Sub AddSpaceBeforeCitations()
With ActiveDocument.Content
With .Find
.ClearFormatting
.Format = True
.Text = ""
.Wrap = wdFindStop
.Font.Superscript = True
.Execute
End With
Do While .Find.Found
With .Previous(unit:=wdCharacter, Count:=1).characters
If .Last.Text = "." Then
.Last.Text = ". "
End If
End With
.Collapse direction:=wdCollapseEnd
.Move unit:=wdCharacter, Count:=1
.Find.Execute
Loop
End With
End Sub
Sub RemoveSpaceBeforeCitations()
With ActiveDocument.Content
With .Find
.ClearFormatting
.Format = True
.Text = ""
.Wrap = wdFindStop
.Font.Superscript = True
.Execute
End With
Do While .Find.Found
With .Previous(unit:=wdCharacter, Count:=2).characters
If (.Last.Text = ".") Then
.Last.Next(unit:=wdCharacter, Count:=1).characters.Last.Text = vbNullString
End If
End With
.Collapse direction:=wdCollapseEnd
.Move unit:=wdCharacter, Count:=1
.Find.Execute
Loop
End With
End Sub
No matter what approach you take, any code that relies on the VBA .Sentence property or .Word property is going to produce unreliable results. That's because .Sentence has no idea what a grammatical sentence and .Word has no idea what a grammatical word is. For example, consider the following:
Mr. Smith spent $1,234.56 at Dr. John's Grocery Store, to buy 10.25kg of potatoes, 10kg of avocados, and 15.1kg of Mrs. Green's Mt. Pleasant macadamia nuts.
For you and me, that would count as one, 26-word sentence; for VBA it counts as 5 sentences containing 45 words overall. For an accurate word count, use .ComputeStatistics(wdStatisticWords). Sadly there is no .ComputeStatistics(wdStatisticSentences) equivalent for sentences.
I try to use Find.FindText in Word VBA to find the first few letters of a word, then select the rest of that word. For example, if I have:
"Hello , AB-1234-123 check"
I would find "AB-" then select the rest of the word to get "AB-1234-123". I cannot use space as my MoveEndUntil(" ") because, sometimes, the word ends with a period.
So far, my code is
SearchString = "AB-"
With Rng.Find
Do While .Execute(FindText:=SearchString, Forward:=True) = True
Rng.MoveEndUntil (" ")
MsgBox (Rng.Text)
Loop
End With
You can still use MoveEndUntil. If you look at the Help topic for the method, you'll see that the first parameter, named CSet, can hold multiple characters. So it can look for a space as well as a period, a comma, a semicolon, etc.
While testing your code, it also came to my attention that, as it stands, it will go into a continuous loop - always finding only the first instance. So I've taken care of that with the Collapse method so that the next Find sequence starts immediately after the last "found" range.
Dim rng As word.Range
Dim SearchString As String
Set rng = ActiveDocument.content
SearchString = "AB-"
With rng.Find
Do While .Execute(findText:=SearchString, Forward:=True) = True
rng.MoveEndUntil (" .,;!")
MsgBox rng.Text
rng.Collapse wdCollapseEnd
Loop
End With
Perhaps you can select the found word portion, then expand it to the whole word?
Selection.Expand Unit:=wdWord
I have created the following to comma separate a list of numbers within a ms-word document. However, I also want to wrap each number with single qoutation marks - which I am struggling to get right. I have managed to wrap the first number however I cant execute it for the others. Each number is 12 digits long. Can someone assist?
Sub Macro1()
With Selection
.Find.Text = "^p"
.Find.Replacement.Text = ","
.Find.Execute Replace:=wdReplaceAll
.TypeText Text:="'"
.MoveRight Unit:=wdCharacter, Count:=12
.TypeText Text:="'"
End With
End Sub
Alternative and quicker solution is to use wildcards for another find-replace. Complete code will look as follows:
Sub Macro1()
With Selection
'1st step- replacement paragraph marks into commas
.Find.Text = "^p"
.Find.Replacement.Text = ","
.Find.MatchWildcards = False
.Find.Execute Replace:=wdReplaceAll
'2nd step- adding single quotation marks
.Find.Text = "([0-9]{12})"
.Find.MatchWildcards = True
.Find.Replacement.Text = "'\1'"
.Find.Execute Replace:=wdReplaceAll
End With
End Sub
You need to move the transformation outside of the With block, I think.
I am not a Word VBA expert, so this is an approach that uses common string functions, rather than replicating keyboard input. So, there are likely different approaches to accomplish the same task :) I suspect this is the "correct" way to do it, since it's generally advisable not to mimic "input" but rather to work directly with the objects.
Revised so that you do not need to physically "Select" the text
Note: this uses all text in the document, so you may need to modify.
Sub Test()
Dim doc As Document
Dim arr As Variant
Dim txtRange As Range
Dim i As Long
Set doc = ActiveDocument
Set txtRange = doc.Range(0, doc.Characters.Count)
'First, replace the paragraph breaks with commas
With txtRange.Find
.Text = "^p"
.Replacement.Text = ","
.Execute Replace:=wdReplaceAll
End With
arr = Split(Left(txtRange.Text, Len(txtRange.Text) - 1), ",")
For i = LBound(arr) To UBound(arr)
arr(i) = "'" & arr(i) & "'"
Next
txtRange.Text = Join(arr, ",")
End Sub
UPDATE FROM COMMENTS
I have confirmed absolutely that this is working. Please double-check that you have implemented the code correctly. Here is an example of some text which meets your description:
I select that text, and run the macro, stepping through it using F8. At the end of the With block, observe that the paragraph breaks have been replaced with commas:
After the For...Next loop has exited, I confirm using the Locals window, that the new array now contains numbers enclosed in single quotes:
The next line prints out those items from the array, and replaces the Selection.Text, confirmed:
I have re-worked my original code, and this runs really quickly over large data sets. I've now added in brackets at the start and end of the code too.
Sub TestN()
Options.AutoFormatAsYouTypeReplaceQuotes = False
'Replace the paragraph breaks with commas and single quotes
With ActiveDocument.Range(0, ActiveDocument.Range.End - 1).Find
.Text = "^p"
.Replacement.Text = "','"
.Execute Replace:=wdReplaceAll
End With
Options.AutoFormatAsYouTypeReplaceQuotes = True
'Cap body of data with single quotes and brackets
ActiveDocument.Content.Text = "('" & ActiveDocument.Range(0, ActiveDocument.Range.End - 1).Text & "')"
End Sub
I have VBA for Word that adds a button to the context menu of the right click which launches my application (which works).
I need the word clicked on to pass it as argument. I saw that I couldn't use Selection because right click doesn't select the word, it gives me the letter after the cursor.
With what I've read, I could possibly look at the position of the cursor, then look at both sides to where the word begins and finishes.
This seems to work
Selection.Words(1).Text
Edit
A little more robust to account for ends of sentences.
Sub FindWord()
Dim rWord As Range
If Selection.Words(1).Text = vbCr Then 'end of sentence
'get last word of sentence
Set rWord = Selection.Words(1).Previous(wdWord)
Else
'get selected word
Set rWord = Selection.Words(1)
End If
'There has to be a better way than this
If rWord.Text = "." Or rWord.Text = "?" Then
Set rWord = rWord.Previous(wdWord)
End If
Debug.Print rWord.Text
End Sub
Here is the most simple way to check for the word under the cursor.
Sub Sample()
Dim pos As Long
'~~> if the cursor is at the end of the word
Selection.MoveEnd Unit:=wdCharacter, Count:=1
Do While Len(Trim(Selection.Text)) = 0
'~~> Move one character behind so that the cursor is
'~~> at the begining or in the middle
Selection.MoveEnd Unit:=wdCharacter, Count:=-1
Loop
'~~> Expand to get the word
Selection.Expand Unit:=wdWord
'~~> Display the word
Debug.Print Selection.Text
End Sub