Code to highlight italic text:
Sub Bold_Italic()
Dim rng As Range
Set rng = ActiveDocument.Range
rng.Collapse Direction:=wdCollapseStart
rng.Find.ClearFormatting
rng.Find.Font.Italic = True
rng.Find.Replacement.ClearFormatting
rng.Find.Replacement.Highlight = True
rng.Find.Replacement.Font.Color = wdColorRed
With rng.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
rng.Find.Execute Replace:=wdReplaceAll
End Sub
How can i highlight the whole paragraph or make selected for a paragraph?
Actually, i want to copy and paste paragraph by paragraph to another document.
I believe you're looking for range.select
Sub Macro()
Dim i As Integer
For i = 1 To ActiveDocument.Paragraphs.Count
Dim range As range
Set range = ActiveDocument.Paragraphs(i).range
'range.Characters.Count > 1 means there is text in the paragraph
If range.Characters.Count > 1 Then
'Handle the desired operation with the paragraph text
range.Select
MsgBox (range.Text)
End If
Next i
End Sub
Related
I would like to search for and highlight two words--say, "box" and "blue"--throughout a Word document. But I only want to highlight the first instance of each word in each paragraph. Sometimes in my document, the word "box" pops up 6 or 7 times in a paragraph, and that's too much. I just want to know the paragraph involves the word "box" with a single highlight.
I can search for all the instances of these two words with the code below. Unfortunately, however, my attempts at doing what I say above have been so disastrous that I am embarrassed to write more code than what works below.
Any help would be greatly appreciated.
Code:
Sub BoxBlue()
Dim range As range
Dim i as Long
Dim tlist
tlist = array("box", "blue")
For i = 0 to UBound(tlist)
Set range = ActiveDocument.range
With range.Find
.Text = tlist(i)
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex=wdYellow
Loop
End With
Next
End Sub
Try:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, ArrFnd()
ArrFnd = Array("box", "blue")
For i = 0 To UBound(ArrFnd)
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ArrFnd(i)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found = True
.HighlightColorIndex = wdYellow
.End = .Paragraphs.Last.Range.End
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
Application.ScreenUpdating = True
End Sub
I want to delete a paragraph that starts with string "Page:" from the selection
Here is the sample text that I have:
Page: 28
Page: 44 contains a lot of example. But look up here for the detailed
explanation. This may go for more than one, two or three lines. This
totally depends upon the length of the text
Date: 10 Jan 2018
Some text goes here with Page: 108
I’ve some more text here
Few more
Final Text
Page: 208
This is the end
The code I have so far:
Sub DelPara()
Dim para As Paragraph
With Selection.Range.Find
.ClearFormatting
.Text = "[^13^11]Page:"
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If (Selection.Range.Find = True) Then
para.Range.Delete
End If
End With
End Sub
The output should be
Date: 10 Jan 2018
Some text goes here with Page: 108
I’ve some more text here
Few more
Final Text
This is the end
The code below will search all instances of the search term in the current selection and delete the search term plus the entire paragraph in which the end of the term is located.
The key to this is using two Range objects: one for the original Range to be searched (the selection), the other for the actual search. In this way, the range that performs the actual search can be extended from the end of the last successful search to the end of the original range.
Sub DelPara()
Dim rngFind As Word.Range, rngSel As Word.Range
Dim para As Paragraph
Dim bFound As Boolean
Set rngSel = Selection.Range
Set rngFind = rngSel.Duplicate
With rngFind.Find
.ClearFormatting
.text = "[^13^11]Page:"
.Forward = True
.MatchWildcards = True
.wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
bFound = rngFind.Find.Execute
Do While bFound
rngFind.End = rngFind.paragraphs.Last.Range.End
rngFind.Delete
rngFind.Collapse wdCollapseEnd
rngFind.End = rngSel.End
bFound = rngFind.Find.Execute
Loop
End Sub
All you need is a wildcard Find/Replace with:
Find = ^13Page:[!^13]{1,}
Replace = nothing
No code required. At most, you might need to insert an empty paragraph at the beginning of the document and delete it afterwards - but then only if the first para starts with 'Page:'. Nevertheless, as a macro:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
.InsertBefore vbCr
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^13Page:[!^13]{1,}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
.Characters.First = vbNullString
End With
Application.ScreenUpdating = True
End Sub
If you want to process only the selected range, change 'ActiveDocument' to 'Selection'.
How can I delete the text between <de> and the end-of-cell marker throughout my Word document?
I have reached the following code from my previous question. It appeared not to be working because my lines end with end-of-cell markers. So now I need to update this to delete the text between <de>and the end-of-cell marker.
I am unable to implement that in this code.
Sub FindTheDeleteToEndOfLine()
Dim searchTerm As String
Dim bFound As Boolean
searchTerm = "<de>"
Selection.HomeKey wdStory
'Basic Find settings
With Selection.Find
.Forward = True
.wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Execute the Find
Do
With Selection.Find
.Text = searchTerm
bFound = .Execute
If bFound Then
Selection.MoveEnd wdLine, 1
Selection.MoveEnd wdCharacter, -1
Selection.Delete
End If
End With
Loop While bFound
End Sub
Update: I worked out a new code less complicated, but again i am unale to define the arng.words in order to delete last part after <de>:
Dim arng As Range
Dim i As Long, j As Long
With Selection.Tables(1)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count
Set arng = .Cell(i, j).Range
arng.End = arng.End - 1
'Text = "<de>"
If Right(arng.Words, 1) = "<de>" Then
arng.Words.Last = Left(arng.Words, Len(arng.Words) - 1)
End If
Next j
Next i
End With
Try, for example:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<de>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
If .Information(wdWithInTable) = True Then
.End = .Cells(1).Range.End - 1
.Delete
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
The problem you're encountering here is due to how Word reacts to a selection inside a cell: as soon as it reaches the end of the cell it selects the entire cell.
I've modified the code (which makes it more "complicated") to take this into account. In order to deal with this, there is now a Range object in the code that stores the original "Found" point in the document. After extending the selection to the end of the line, and moving it back one character (which means the entire cell is selected), the starting point is re-set to the "found" position.
Sub FindTheDeleteToEndOfCell()
Dim searchTerm As String
Dim bFound As Boolean
Dim rngFound As Word.Range
searchTerm = "<de>"
Selection.HomeKey wdStory
'Basic Find settings
With Selection.Find
.Forward = True
.wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Execute the Find
Do
With Selection.Find
.Text = searchTerm
bFound = .Execute
If bFound Then
Set rngFound = Selection.Range
Selection.MoveEnd wdLine, 1
Selection.MoveEnd wdCharacter, -1
Selection.Start = rngFound.Start
Selection.Delete
End If
End With
Loop While bFound
End Sub
I'm trying to find a regex string, <XE "i#>, in a Word document.
Background: I'm building an index, and automatically picking up paragraphs to add via another macro. There are some entries that start "i. Automobile - means a car", or "ii. Super - means really good". I want to remove the numbering part from the Index entry, so thought a way to do so would be to look for the {XE "i. Automobile ...} part and just remove the i. using RegEx.
When I search manually for my string, it works fine and picks up the matches. However, my macro doesn't work. When stepping through, then I get to While .Execute, the next step just goes to Wend then End With. It does ask if I want to search from the beginning, so the .Find is working somewhat, but why isn't it finding any matches?
Thanks so much for any advice!
Sub Hide_Roman_Numerals_from_Index()
Dim defText As String
Dim regExSearch As String
Dim oRng As Word.Range, rng As Word.Range
If ActiveWindow.ActivePane.View.ShowAll = False Then
ActiveWindow.ActivePane.View.ShowAll = True
End If
Set oRng = ActiveDocument.Range
'Call ClearFindAndReplaceParameters(oRng)
regExSearch = "<XE ""i#>"
oRng.Find.ClearFormatting
With oRng.Find
.Text = regExSearch
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
While .Execute
Set rng = oRng.Paragraphs(1).Range
rng.Select
Wend
End With
If ActiveWindow.ActivePane.View.ShowAll = True Then
ActiveWindow.ActivePane.View.ShowAll = False
End If
'Call ClearFindAndReplaceParameters(oRng)
End Sub
I think this approach will suit you if I got your problem right.
'BruceWayne
Sub Colorgreenfromw()
Application.ScreenUpdating = False
Dim oPar As Paragraph
Dim oRng As Word.Range
For Each oPar In ActiveDocument.Paragraphs
Set oRng = oPar.Range
With oRng
With .Find
.ClearFormatting
.Font.Color = wdColorGreen
.Replacement.ClearFormatting
.Text = "<XE ""i#>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
If .Find.Found Then
Set oRng = oPar.Range
oRng.Font.Color = wdColorGreen
Set oRng = Nothing
End If
End With
Next
End Sub
I am trying to find all dashes that are alone in table cells and center them. What i have built below thus far will center all dashes in the document. How can I encapsulate this to center only the dashes in cells by themselves?
Sub Macro9()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.Alignment = wdAlignParagraphCenter
End With
With Selection.Find
.Text = "-"
.Replacement.Text = "-"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Since you want to restrict your searches to only a single dash in a single cell, you're better off only checking cell contents. Otherwise if you use .Find in the range of a table, you'll have to check all sorts of special cases to make sure the "found" dash is all alone in the cell. I think this works pretty efficiently:
Option Explicit
Sub Macro9()
Dim tbl As Table
Dim tCell As Cell
Dim r, c As Integer
Dim cellContents As String
For Each tbl In ActiveDocument.Tables
For r = 1 To tbl.Rows.Count
For c = 1 To tbl.Columns.Count
Set tCell = tbl.Cell(r, c)
'--- trim the cell delimiter off the end, then whitespace
cellContents = Left(tCell.Range.Text, Len(tCell.Range.Text) - 2)
cellContents = Trim(cellContents)
If cellContents = "-" Then
tCell.Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End If
Next c
Next r
Next tbl
End Sub
#PeterT what are you thoughts on this? (a collegue and I pulled it together)
Sub Macro1()
Dim CurrentText As Range
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "-"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While Selection.Find.Execute
If Selection.Information(wdWithInTable) Then
Set CurrentText = Selection.Cells(1).Range
CurrentText.End = CurrentText.End - 1
If (CurrentText.Text = "-") And Not (Selection.Information(wdAlignParagraphCenter)) Then
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End If
End If
Loop
End Sub