I am using the find option in word VBA and want to paste a graph in the next paragraph wherever i find my text.
Set myRange = ActiveDocument.Content
With myRange.Find
.Text = "Chart"
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = False
bFound = .Execute
End With
If bFound Then
Set ChartObj = wb1.ChartObjects("Chart 1")
ChartObj.Chart.ChartArea.Copy
.Words.Last.Paste
End If
The .words.Last.Paste pastes the graph at the end of the document instead of pasting it at the end of word "Chart" which I am seraching. How do I instert a paragraph at the end of line where i find my text and paste the chart there ?
I also tried the bookmark approach, such that my graphs gets pasted at the next paragraph after text 'My Chart here', but don't know how to move the cursor to the end of my text and then add paragraph there.
.Bookmarks('chart').Range.Text = 'My Chart here'
The text 'My chart here' has more than 1 character but when i use the code below i only get 1 as answer. What I am missing here ?
Msgbox .Bookmarks('chart').Range.Characters.Count
.Words is a property of the Range object, so you need to use myRange.Words.Last.Paste
Sub test()
Set myRange = ActiveDocument.Content
With myRange.Find
.Text = "Insert"
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = False
bFound = .Execute
End With
If bFound Then
Set ChartObj = wb1.ChartObjects("Chart 1")
ChartObj.Chart.ChartArea.Copy
myRange.Words.Last.Paste
End If
End Sub|
Related
I am trying to create a Word macro that will:
Search for a specific word (i.e. "see")
Select the entire paragraph where that word appears
Make the whole paragraph a different style (i.e. make it all red text)
Do the same thing with a second word (i.e. "blacklist")
Select that whole paragraph and apply a different style (i.e. again, make the paragraph red text)
Copy all paragraphs with the red text style and paste them in to a new word document
Unfortunately, I'm no VBA expert and I'm trying to cobble things together from what I can find online. I have found a great example that will select to the start of the paragraph, but I can't seem to figure out how to select the entire paragraph. Any help is appreciated!
** Sorry - here is the code I currently have. It will find all instances of the word "see" and selects to the start of the paragraph, then changes the color to red... but that's as far as I've gotten, as I am stuck on trying to figure out how to get it to select to the end of the paragraph.
Sub TestOne()
'
' TestOne Macro
'
'
If MsgBox(Prompt:="Would you like to update selected paragraph styles?", Buttons:=vbYesNo + vbQuestion, _
Title:="Format MD Report") = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "see"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = False
End With
Do While .Find.Execute
i = i + 1
.Start = .Paragraphs.First.Range.Start
.Font.Color = wdColorRed
.Start = .Paragraphs.First.Range.End
Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances processed."
End Sub
For example, without needing to create a second document:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrFnd As String
StrFnd = "see|blacklist"
With ActiveDocument.Range
.Font.Hidden = True
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Text = "^&"
.Font.Hidden = True
.Replacement.Font.Hidden = False
.Format = True
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
For i = 0 To UBound(Split(StrFnd, "|"))
.Text = "[!^13]#" & Split(StrFnd, "|")(i) & "*^13"
.Execute Replace:=wdReplaceAll
Next
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub
You could, of course, add a line of code before the final 'End With' to save the document with a new name.
To select the entire paragraph, following the line
.Start = .Paragraphs.First.Range.Start
add
.End = .Paragraphs.First.Range.End
... then to match only whole words, after
.MatchWildcards = False
add
.MatchWholeWord = True
And to run the code for multiple words you should add a parameter to your Sub eg
Sub TestOne(theWord As String)
then replace
.Text = "see"
with
.Text = theWord
And to run your code for each required word, add a Sub such as
Sub RunMe()
TestOne "see"
TestOne "blacklist"
End Sub
... optionally, move your MsgBoxes into RunMe()
The code is intended to add the same hyperlink to all Heading 1 style text. (Purpose: clicking any heading brings you to the top of the document).
It works for the first Heading Style text. It does not advance to the next instance.
I found this was due to the line which adds the hyperlink. When this line is removed, all the Heading 1 style text is found (but of course then I can't add the link).
Sub addLinksToAllTextHavingCertainStyle()
Dim r As Range
Set r = ActiveDocument.Content
r.Find.ClearFormatting
Do
With r.Find
.Text = ""
.Replacement.Text = ""
.Style = "Heading 1"
.Forward = True
.Wrap = wdFindStop
.Format = True
.Execute
End With
r.Select 'for testing
ActiveDocument.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:="_top", ScreenTip:=""
Loop
End Sub
You're looping the wrong part of the code. As written your code loops the entire find, which means it just starts over from the beginning each time.
It is only the execution of the Find that needs to be looped, the parameters you have set will remain. When Find is executed the range that the Find is executed on is redefined to the found match, so in a loop you need to collapse the range to the end to avoid the match being endlessly re-found.
Sub addLinksToAllTextHavingCertainStyle()
Dim r As Range
Set r = ActiveDocument.Content
With r.Find
.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Style = "Heading 1"
.Forward = True
.Wrap = wdFindStop
.Format = True
End With
Do While r.Find.Execute = True
ActiveDocument.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:="_top", ScreenTip:=""
r.Collapse wdCollapseEnd
Loop
End Sub
In a long Word document I'd like to do the following:
Find all 'Heading 2' styles paragraphs, and IF those headings are not worded "Notes" then apply a certain style to the immediately following paragraph.
Here's my code:
Dim oPara As Paragraph
For Each oPara In ActiveDocument.Paragraphs
If oPara.Style = "Heading 2" And oPara.Range.Text <> "Notes" Then
oPara.Range.Next(Unit:=wdParagraph, Count:=1).Select
Selection.Style = "Normal"
End If
Next oPara
However, the paragraphs worded "Notes" are not excluded from the procedure so those following them also get converted to style "Normal". I'm not even sure oPara.Range.Text actually retrieves the wording of the paragraph.
Thank you.
I agree with Timothy. The following is faster still - and simpler. It's also more reliable, since Timothy's code matches on 'Notes' anywhere in the paragraph instead of 'Notes' being the whole of the paragraph text.
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Style = ActiveDocument.Styles(wdStyleHeading2)
.Forward = True
.Format = True
.Wrap = wdFindStop
End With
Do While .Find.Execute = True
If .Text <> "Notes" & vbCr Then .Next(wdParagraph, 1).Style = wdStyleNormal
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
Try like this:
Dim oPara As Paragraph
For Each oPara In ActiveDocument.Paragraphs
If oPara.Style = "Heading 2" And Replace(oPara.Range.Text, Chr(13), "") <> "Notes" Then
oPara.Range.Next(Unit:=wdParagraph, Count:=1).Select
Selection.Style = "Normal"
End If
Next oPara
It seems that Word includes a carriage return Chr(13) after the header text, so when checking if the header text is "Notes", the carriage return must be removed.
The most efficient way of finding all the instances of 'Heading 2' is to use Find. You can then test the text of the found range and if it meets your criteria apply the style to the following paragraph.
Sub FormatAfterHeading()
Dim findRange As Range
Set findRange = ActiveDocument.Content
With findRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Style = ActiveDocument.Styles(wdStyleHeading2)
.Forward = True
.Format = True
.Wrap = wdFindStop
Do While .Execute = True
If InStr(findRange.Text, "Notes") > 0 Then
'do nothing
Else
findRange.Next(wdParagraph, 1).Style = wdStyleNormal
End If
findRange.Collapse wdCollapseEnd
Loop
End With
End Sub
I'm new to VBA. I have several long documents where a citation or a document number appears at the end of a paragraph. Luckily, these citations and document are enclosed in parentheses, which should make it easy to isolate. I need to move the content of those parentheses (including the parentheses themselves) to the front of each paragraph and then add two spaces after the closing parenthesis.
For example:
This is my text in Paragraph 1. (http://nytimes.com)
This is my text in Paragraph 2. (1.b.3B)
Should look like:
(http://nytimes.com) This is my text in Paragraph 1.
(1.b.3B) This is my text in Paragraph 2.
I found the answer in the following link useful, but can't seem to apply it to my case: Get paragraph no where txt is found, and move text to end of paragraph using Word 2010 vba
Many thanks in advance.
Here's what I have up to now, but the script just doesn't seem to run:
Sub Test1()
Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.Content
Dim currPara As Paragraph
Dim strText As String
Selection.HomeKey Unit:=wdStory ' Start from the beginning of the doc.
For Each currPara In docRng.Paragraphs ' Loop through the paragraphs in the active document.
Set currRng = currDoc.Range(currPara.Range.Start, currPara.Range.End) ' Selects the current paragraph, so that the search is conducted paragraph by paragraph.
With Selection.Find
.ClearFormatting
.Text = "\(*\)"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
If currRng.Find.Execute Then
With Selection
.Select
.Cut
.StartOf Unit:=wdParagraph
.Paste
.InsertAfter " "
End With
End If
Next currPara
End Sub
You were very close to correct solution to move simple text. But, what I realised, it was a problem to move hyperlinks as syntax "\(*\)" didn't recognise hyperlinks. Therefore I put some additional small modifications. That works for me in Word 2010:
Sub Test1_Tested_incl_Hyper()
Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.Content
Dim currPara As Paragraph
Dim strText As String
Selection.HomeKey Unit:=wdStory ' Start from the beginning of the doc.
For Each currPara In docRng.Paragraphs ' Loop through the paragraphs in the active document.
Set currRng = currDoc.Range(currPara.Range.Start, currPara.Range.End) ' Selects the current paragraph, so that the search is conducted paragraph by paragraph.
currRng.Select
With Selection.Find
.ClearFormatting
.Text = "\("
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute
End With
If Selection.Find.Found Then
With currDoc.Range(Selection.Range.Start, currPara.Range.End - 1)
.Select
.Cut
.StartOf Unit:=wdParagraph
.Paste
.InsertAfter " "
End With
End If
Next currPara
End Sub
EDIT- code for footers
Sub Test1_for_Footers()
Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.StoryRanges(wdPrimaryFooterStory)
Dim currPara As Paragraph
Dim strText As String
For Each currPara In docRng.Paragraphs
currPara.Range.Select
With Selection.Find
.ClearFormatting
.Text = "\("
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute
End With
If Selection.Find.Found Then
Selection.Extend ")"
With Selection
.Select
.Cut
.StartOf Unit:=wdParagraph
.Paste
.InsertAfter " "
End With
End If
Next currPara
End Sub
With the Find function(Ctrl+F) I can search and select all words in Italicized font from a document.
How would this be done with vba?
I tried the macro recorder but the code I get there does not work.
Sub Makro1()
'
' Makro1 Makro
' Makro aufgezeichnet am 16.06.2011 von u0327336
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End Sub
The goal would be to have all italic font words being selected/highlighted in the document.
thanks,
kay
The last effort actually works a treat in Word 2010. I'm not sure why the report was that it didn't work.
Here it is changed to ASCIIfy italics, which is what I want for text-based newsgroups:
Sub ASCIIfy()
Dim myString As Word.Range
Set myString = ActiveDocument.Content
With myString.Find
'// ensure unwanted formats aren't included as criteria
.ClearFormatting
'// we don't care what the text is
.Text = ""
'// find the italic text
.Font.Italic = True
'// loop for each match and surround with "_"
While .Execute
myString.Text = "_" & myString & "_"
myString.Font.Italic = False
myString.Collapse wdCollapseEnd
Wend
End With
End Sub
You may need to add :
Selection.Find.Font.Italic = True
That could became :
With Selection.Find
.Text = ""
.FOnt.Italic = True
'other search stuff
End with
EDIT: another try (not complete though)
Sub hilightItalic()
With ActiveDocument.Content.Find
' to ensure that unwanted formats aren't included as criteria
.ClearFormatting
'You don't care what the text is
.Text = ""
'Find the italic text
.Font.Italic = True
'Delete the text found
.Replacement.Text = ""
'delete all italic text
.Execute Replace:=wdReplaceAll
'.HitHighlight "", vbYellow, vbRed
End With
End Sub
But yet, the replace does work well but highlight does not work if there is no text. Anyone has an idea ?
EDIT 2: Found a working solution, even if i did not manage to have hithighlight working though
Sub hilightItalic()
Dim oRng As Word.Range
Set oRng = ActiveDocument.Content
With oRng.Find
' to ensure that unwanted formats aren't included as criteria
.ClearFormatting
'You don't care what the text is
.Text = ""
'Find the italic text
.Font.Italic = True
'Loop for each match and set a color
While .Execute
oRng.HighlightColorIndex = wdDarkYellow
oRng.Collapse wdCollapseEnd
Wend
End With
End Sub
Regards,
Max
Set Selection.Find.Font.Italic = True.
Selection.Find.ClearFormatting
' The next line does the trick.
Selection.Find.Font.Italic = True
With Selection.Find
.Text = "YourText"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Hint for the next time: Record a macro, perform the actions you want to automate, and look what code is recorded. That's how I found this. :D
[edit]
I see that you tried recording it. Weird that that didn't work.. :-S
You need to iterate through the cells in the range that you want to check, and specifically check if it has its font italicized. AFAIK .Italic is not a "findable" option.
The following code is an example of iterating through the cells to find what you need.
Sub TestMe2()
Dim rng As Range
'// change as needed to the proper worksheet reference
With ThisWorkbook.Worksheets(1)
'// replace the .Range statement with an appropriate range for your data
For Each rng In .Range(.Cells(1, 1), .Cells(100, 100))
If rng.Font.Italic = True Then
'// uses the yellow highlight color, change to suit your needs
rng.Interior.Color = 65535
End If
Next rng
End With
End Sub