I've changed balloon comments to footnotes, taking the author's name too. I need the author's name to be in bold but I can't get my code to read the footnotes. My problem is in setting : oFootnote
I've tried calling on the strAuthor and making that bold but because it is no longer a comment.author I can no longer set it as it's now in the footnote. I've tried many examples on the internet but I just can't get them to work:
StackOverflow's How do i make a string bold; Insert bold text into Word using VBA
also
Set oFootnote = oDoc.Footnotes.Add(Range:=Selection.Range, Text:="Some text")
I am a trainee so please don't judge me too harshly
'Convert comments to footnotes with Author name in bold
Dim i As Long
Dim oDoc As Document
dim oComment as Comments
Dim oFootnote As Footnotes
'Document is the ActiveDocument
Set oDoc = Application.ActiveDocument
'the author's name needs to be bold (the last two words in each footnote)
Set oFootnote = oDoc.Footnotes
With oFootnote
Selection.Range.Words.Last.Words (2)
'Make the last two words bold'
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Font.bold = True
End With
End With
Selection.Find.Execute
'Set oFootnote = Nothing
Next
I tried
Set oFootnote = oDoc.Footnotes Range:=Selection.Words.Last.Words(2)
but it doesn't like "Range:= onwards" so I did
Selection.Range.Words.Last.Words (2) invalid use of a property
There is usually more than one way to achieve something like this, but the key is usually to work with a dedicated Range object.
In the code below, that bases on the code in the question, the Range object is assigned to each individual Footnote object in a loop of the Footnotes. It is then collapsed to its end-point and the start extended backwards by two words. (To better understand how this works, think of selecting the footnote, pressing right-arrow, then pressing ctrl+shift+left arrow twice to select the last two words.)
Dim oDoc As Document
Dim oFootnotes As Footnotes
Dim Ftnote As Footnote
Dim rngFootnote As Word.Range
'Document is the ActiveDocument
Set oDoc = Application.ActiveDocument
'the author's name needs to be bold (the last two words in each footnote)
Set oFootnotes = oDoc.Footnotes
For Each Ftnote In oFootnotes
Set rngFootnote = Ftnote.Range
rngFootnote.Collapse wdCollapseEnd
rngFootnote.MoveStart wdWord, -2
rngFootnote.Font.Bold = True
Next
Note that the reason for one of the errors in the question is because Words.Last returns a Range object containing the last word. Since it contains only one word - the last - Words(2) can't find anything it can work with.
The reason for the other error is that it's not possible to assign a Range to a Footnote or Footnotes object. They're different things, entirely...
Not super familiar with word objects, but try this. Worked for my couple of tests.
Basically it loops through all foot notes. And uses the index of the word to set that word's bold property to true.
Sub Test()
Dim oFootNote As Footnote
Dim oLastIndex As Long
For Each oFootNote In ActiveDocument.Footnotes
oLastIndex = oFootNote.Range.Words.Count
If oLastIndex > 2 Then
oFootNote.Range.Words(oLastIndex).Bold = True
oFootNote.Range.Words(oLastIndex - 1).Bold = True
End If
Next
End Sub
How can I align a paragraph with just the text portion of a numbered heading? e.g:
1.1.2 This Is A Numbered Heading
This is the aligned text I'm trying to achieve
This is aligned to the numbers not the text
2.4 This Is Another Example
This is where the text should be
I'm aware of the CharacterUnitLeftIndent, CharacterUnitFirstLineIndent, FirstLineIndent etc properties but after a few hours experimentation & searching online can't figure out how to achieve this programmatically. I know how to test for the heading style and how to refer to the following paragraph so just need to know how to get the indent right.
To use a macro to accomplish this, you have to check each paragraph in your document and check to see if it is a "Header" style. If so, then pick off the value of the first tab stop to set as the indent for the subsequent paragraphs.
UPDATE1: the earlier version of the code below set the paragraphs to the Document level first tab stop, and did not accurately grab the tabstop set for the Heading styles. The code update below accurately determines each Heading indent tab stop.
UPDATE2: the sample text original I used in shown in this first document:
The code that automatically performs a first line indent to the tab level of the preceding heading is the original Sub from the first example:
Option Explicit
Sub SetParaIndents1()
Dim myDoc As Document
Set myDoc = ActiveDocument
Dim para As Paragraph
Dim firstIndent As Double 'value in "points"
For Each para In myDoc.Paragraphs
If para.Style Like "Heading*" Then
firstIndent = myDoc.Styles(para.Style).ParagraphFormat.LeftIndent
Debug.Print para.Style & " first tab stop at " & _
firstIndent & " points"
Else
Debug.Print "paragraph first line indent set from " & _
para.FirstLineIndent & " to " & _
firstIndent
para.FirstLineIndent = firstIndent
End If
Next para
'--- needed to show the changes just made
Application.ScreenRefresh
End Sub
And the results looks like this (red lines added manually to show alignment):
If you want the entire paragraph indented in alignment with the heading style, the code is modified to this:
Option Explicit
Sub SetParaIndents2()
Dim myDoc As Document
Set myDoc = ActiveDocument
Dim para As Paragraph
For Each para In myDoc.Paragraphs
If para.Style Like "Heading*" Then
'--- do nothing
Else
para.Indent
End If
Next para
'--- needed to show the changes just made
Application.ScreenRefresh
End Sub
And the resulting text looks like this:
i receive reports (word document in .doc format ) from clients which due to some processes at their end are missing periods () at the end of most paragraphs. I have to manually add periods. Is there any code in word vba macros to accomplish this.
Thank you.
This is a fairly simple example on how to add a period to every paragraph that contains text. You could extend it to see if the paragraph really has no period at the end but I leave that up to you to decide.
Call the Macro from the Developer Tab after you added the macro:
Sub TestAddPeriod()
Dim oPara As Word.Paragraph
Dim rng As Range
Dim text As String
For Each oPara In ActiveDocument.Paragraphs
If Len(oPara.Range.text) > 1 Then
Set rng = ActiveDocument.Range(oPara.Range.Start, oPara.Range.End - 1)
rng.InsertAfter "."
End If
Next
End Sub
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