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
Related
i have following problem. Im currently creating a Macro that gets every font thats been used in a Word document. Afterwards it checks, if this font is even installed and changes the font into predefined fonts. (As the Microsoft auto-font-change in Word is pretty bad and changes my fonts into Comic Sans (no joke ...).
Everything works as intended except for one thing.
This here is the code i am using to exchange every occurence of the found
font in the document:
For i = 0 To UBound(missingFont)
For Each oCharacter In ActiveDocument.Range.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
So basically im checking every Character in my document and change it if needed. Now this only works for Characters that are not inside of textfields, the header or footer. How can i check every, EVERY, character inside of the Document?
First i've tried to use ActiveDocument.Range.Paragraphs instead of ActiveDocument.Range.Characters. I've also tried using the macro given here: http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldnt get this to work at all.
It's not clear what is meant by "textfield" as that could be any of five or six different things in Word...
But there is a way to access almost everything (excluding ActiveX controls) in a Word document by looping all StoryRanges. A StoryRange includes the main body of the document, headers, footers, footnotes, text ranges in Shapes, etc.
The following code sample demonstrates how to loop all the "Stories" in a document. I've put the code provided in the question in a separate procedure that's called from the "Stories" loop. (Note that I am not able to test, not having access to either the documents or relevant portions of code used in the question.)
Sub ProcessAllStories()
Dim doc as Word.Document
Dim missingFont as Variant
Dim myStoryRange as Word.StoryRange
'Define missingFont
Set doc = ActiveDocument
For Each myStoryRange In doc.StoryRanges
CheckFonts myStoryRange, missingFont
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
CheckFonts myStoryRange, missingFont
Loop
Next myStoryRange
End Sub
Sub CheckFonts(rng as Word.Range, missingFont as Variant)
Dim oCharacter as Word.Range
For i = 0 To UBound(missingFont)
For Each oCharacter In rng.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
End Sub
I'm trying to clean up my Word document using VBA.
What i need to do is to find a specific word (usually a website) then select the line it is in and then select and then remove text line above(only 1 line), the lines under that website line as well (sometimes more than 2 - if the text is longer). I'll try to show you how the line looks now.
Something happend at someplace!
website.com 08.01.2019
Something happend at someplace and it was a bad person doing it.
He used spaces instead of tabs in his code.
TAG-important stuff
The website 99% of times doesn't show in the 1st line, so im trying to find the 2nd line.
There are other websites and texts i would like to keep (so it would skip newsbetter.com)
In every document there are about 30-100 pharagraphs like the one I've typed earlier (the ones do delete)
I've been searching on the internet for a possible solution but they usually are for Excel. I think that strings are not working for me here.
Sub ScratchMacroII()
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "news.pl"
While .Execute
While oRng.Find.Found
oRng.Select
Selection.Expand Unit:=wdParagraph
Selection.Delete
Wend
End With
End Sub
I expected the result to delete the whole pharagraph, but it justs deletes one line and leaves the other ones. I need some pointers since I'm new at VBA.
The following code, based on the sample in the question, searches the term from the beginning to the end of the document. When found, the paragraphs following and preceding the term are deleted. The search Range is then set to the document content following the found instance so that the same instance is not picked up repeatedly.
Note that I included Find.Wrap = wdFindStop to prevent the code from cycling through the document again. It's also necessary to repeat the Execute method within the loop, rather than trying to loop on it. While...Wend is an old type of loop; preferred is Do While...Loop.
Sub ScratchMacroII()
Dim oRng As Word.Range
Dim para As Word.Paragraph
Dim found As Boolean
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "news.pl"
.wrap = wdFindStop
found = .Execute
Do While found
Set para = oRng.Next(wdParagraph, 1).Paragraphs(1)
para.Range.Delete
Set para = oRng.Next(wdParagraph, -1).Paragraphs(1)
para.Range.Delete
oRng.Collapse wdCollapseEnd
oRng.End = ActiveDocument.content.End
found = oRng.Find.Execute
Loop
End With
End Sub
I am trying to create a Word macro that will go through a large document that I have and add the text "SAMPLE" to the beginning of every paragraph.
The document contains a Title page, Table of Contents and Headings throughout and I would prefer none of these have the "SAMPLE" text on them, just the paragraphs.
Below is some macro code I have found on various sites and kind of pieced together to do somewhat of what I want. It does place the "SAMPLE" text at the beginning of some paragraphs but not all, usually only the first paragraph of a new section within my document. And it also places it at the end of the Table of Contents and Beginning of the Title page.
I am brand new to macros in Word so any help is appreciated or if there is a better way of doing this perhaps? There might even be some unnecessary bits in this code since it is pieced together from other samples.
Sub SAMPLE()
Application.ScreenUpdating = False
Dim Par As Paragraph, Rng As Range
For Each Par In ActiveDocument.Paragraphs
If Par.Style = "Normal" Then
If Rng Is Nothing Then
Set Rng = Par.Range
Else
Rng.End = Par.Range.End
End If
Else
Call RngFmt(Rng)
End If
If Par.Range.End = ActiveDocument.Range.End Then
Call RngFmt(Rng)
End If
Next
Application.ScreenUpdating = True
End Sub
Sub RngFmt(Rng As Range)
If Not Rng Is Nothing Then
With Rng
.End = .End - 1
.InsertBefore "SAMPLE"
End With
Set Rng = Nothing
End If
End Sub
Provided your Title, Table of Contents and Headings etc. don't use the Normal Style - as they shouldn't - you really don't need a macro for this - all you need is a wildcard Find/Replace where:
Find = [!^13]*^13
Replace = SAMPLE: ^&
and you specify the Normal Style as a Find formatting parameter. You could, of course, record the above as a macro, but that seems overkill unless you're doing this often.
I'm a long-time beneficiary of the helpful advice folks on here have offered to others (sincere thanks, everyone), but this is my first time actually posting. My VBA skills are lackluster at best.
This is driving me nuts: I have an Outlook macro that's supposed to comb through an email message before it's sent and replace citations to our policy documents, all of which have a prefix of "A&P-" with a link to that document.
It actually works great, except that it stubbornly refuses to capture citations if they're the first word in the email. So, for example, if I have a list of entries that looks like this:
A&P-I-A-1-100, A&P-II-B-2-200, A&P-III-C-3-300
the script will add links to the second and third entry (and as many more as I want to add) but skip the first one entirely. Weirdly, if I add any characters at all to the start of the email (even just hitting the space bar a couple of times) this doesn't happen. It doesn't impact citations at the start of subsequent paragraphs either. Just that first word.
Here's the code I'm using. Any help very, very appreciated!:
Sub Citation3()
Dim myInspector As Outlook.Inspector
Dim myObject As Object
Dim myItem As Outlook.MailItem
Dim rngStory As Word.Range
Dim myDoc As Word.Document
Dim mySelection As Word.Selection
Dim strItem As String
Dim strItem2 As String
Dim strLink As String
Set myInspector = Application.ActiveInspector
Set myObject = myInspector.CurrentItem
Set myDoc = myInspector.WordEditor
Set mySelection = myDoc.Application.Selection
For Each rngStory In ActiveDocument.StoryRanges
With mySelection.Find
.ClearFormatting
.Text = "A&P-*-*-[0-9]{3}"
.Replacement.Text = ""
.Wrap = wdFindContinue
.MatchWildcards = True
If mySelection.Find.Execute = True Then
While mySelection.Find.Execute
strItem = mySelection.Text
strItem2 = Replace(strItem, "A&P", "AP")
mySelection.Hyperlinks.Add Anchor:=mySelection.Range, _
Address:="http://www.google.com/" & strItem2 & "_document.shtml", _
TextToDisplay:=strItem
End If
End With
Next rngStory
End Sub
The problem lines are:
If mySelection.Find.Execute = True Then
While mySelection.Find.Execute
When they're isolated like that, you can probably see what's happening.
You're doing one Execute in the If statement which finds the first occurrence of the pattern you're looking for and then immediately do another Execute in the While loop that now finds the second occurrence of that pattern, therefore ignoring the first match completely. After that, the code loops around the While loop and picks up any remaining matches correctly.
To fix this, simply remove the If and corresponding End If lines, because you don't need them. The While loop will take care of everything.
Now, for some observations.
In your code I don't see Next statement for your For Each loop, or a End With statement for your With block, or a Wend statement for your While loop, or a End Sub for that matter. I can only assume you've cut and pasted only selected bits of your code, so I'll ignore that.
You should probably indent your code a little better to make it easier on others (and on you!) to read and identify any potential errors.
Finally, I'm a little confused by your matching pattern: "A&P-*-*-[0-9]{3}". It would work equally well as "A&P*[0-9]{3}" or "A&P-*-*-*-[0-9]{3}". In the latter, note that there are 3 dashed bits of text between the P and the 3-digit number (according to your format specification for citations), whereas your original pattern only accounted for 2 dashed bits.
I want to find a string in a word document and delete everything after it.
What is the best way to do this without using the Selection object?
Use a Range object instead. Straight outta the Word 2003 help:
If you've gotten to the Find object
from the Range object, the selection
isn't changed when text matching the
find criteria is found, but the Range
object is redefined. The following
example locates the first occurrence
of the word "blue" in the active
document. If "blue" is found in the
document, myRange is redefined
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:="blue", _
Forward:=True
If myRange.Find.Found = True Then
Now use the SetRange method of that Range object to make the start of the range be the next character after the end of the string you searched for and make the end of the range be the end of the document:
myRange.SetRange (myRange.End + 1), ActiveDocument.Content.End
(TODO: You'll need to deal with the case when your string is the last thing in the document)
To delete the contents:
myRange.Delete