I have a paragraph like this:
Nov 19, 2014 - You are running the search on the Selection, but you're
not changing that selection between runs. So you just end up making
the same text bold over and over again. Here's a way to do what you're
doing without the Selection object: Sub ParaStyle() Dim objPara As
Paragraph For Each objPara In ... Word VBA Paragraph
formatting-VBForums
And I am trying to change the style of the entire paragraph to a local style. I am using the following code:
Dim rgePages As Range
Dim p As Paragraph
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=3
Set rgePages = Selection.Range
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=6
rgePages.End = Selection.Bookmarks("\Page").Range.End
rgePages.Select
For Each p In rgePages.Paragraphs
If p.Style <> "Heading 1" Then
p.Style = "Body Text"
'p.Style = Word.WdBuiltinStyle.wdStyleBodyText
rgePages.Collapse Word.WdCollapseDirection.wdCollapseEnd
End If
Next
It is working fine till the time any line or a few words are in different style. Say for example if the line
So you just end up making
in the paragraph is in different style, it is marking the whole paragraph as "Body Text" except for that part. Is there a solution to this?
You could try to clear formatting first before you apply your own style. It could go this way:
....
If p.Style <> "Heading 1" Then
p.Range.Select
Selection.ClearFormatting 'it rather works with selection only
p.Style = "Body Text"
....
Related
I have the following code that searches for a certain point in a document and creates a search range until the end of the document. Then within that range it removes the paragraph following entirely bold paragraphs (subheadings), ignoring any styles that aren't Normal and aren't in a table. However, it seems to search the entire document (i.e. the beginning as well). How can I make it only search the range (i.e. from where I've positioned the cursor down to the end of the document)?
Dim aPara As Paragraph
Dim oSearchRange As Range
With Selection.Find
.Text = "Dear "
End With
Selection.MoveDown Unit:=wdParagraph, Count:=4
Set oSearchRange = Selection.Range
oSearchRange.End = ActiveDocument.Content.End
oSearchRange.MoveEnd wdParagraph, -1
For Each aPara In oSearchRange.Paragraphs
If aPara.Range.Font.Bold = True And aPara.Range.Next.Style = ActiveDocument.Styles("Normal") And Not aPara.Range.Next.Information(wdWithInTable) Then aPara.Range.Next.Delete
Next aPara
Thanks
I needed to add .Execute after the "Dear " search, thanks to Teamothy (:
I want to have bold and not bold text in one line.
With objWrdDoc
.Styles.Add ("S2")
.Styles.Add ("S3")
.Styles("S2").Font.Bold = True
.Styles("S3").Font.Bold = False
End With
With objWrdApp.Selection
.TypeParagraph
.Style = objWrdDoc.Styles("S2")
.TypeText Text:="I want to have bold "
.Style = objWrdDoc.Styles("S3")
.TypeText Text:="and not bold text in one line."
End With
As a result, the entire text is not bold.
While working with the Selection object feels "intuitive", it's not as accurate for writing code to manipulate Word as using Range objects. You can think about a Range as being an invisible selection, with the important differences that
code can work with multiple Range objects
the user can't affect where a Range is (clicking on the screen or pressing arrow keys changes a Selection)
tracking where a Range is at any given point in the code is reliable
Changing the code in the question to work with a "target" Range could look as follows.
(Note that I've also added Style objects for the styles being defined. It's much more reliable and a lot less typing to work with objects, rather than constructs such as objWrdDoc.Styles("S3").)
Dim S2 as Word.Style, S3 as Word.Style 'As Object if using late-binding
With objWrdDoc
Set S2 = .Styles.Add("S2")
Set S3 = .Styles.Add("S3")
S2.Font.Bold = True
S3.Font.Bold = False
End With
Dim objRange as Word.Range 'As Object if using late-binding
Set objRange = objWrdApp.Selection.Range
With objRange
.Text = vbCr 'Chr(13) = paragraph mark
'The new text should follow the inserted paragraph mark
'Like pressing right-arrow to "collapse" a selection
.Collapse wdCollapseEnd
'When working with ranges, apply the formatting after writing the text
.Text = "I want to have bold "
.Style = S2
.Collapse wdCollapseEnd
.Text = "and not bold text in one line."
.Style = S3
End With
I have a Word macro that allows to put his/her cursor anywhere in a Word document and it finds and saves the Heading 1, Heading 2 and Heading 3 text that is above the text selected by the user in order capture the chapter, section and sub-section that is associated with any sentence in the document.
I am currently using the code below which moves up the document line-by-line until it finds a style that contains "Heading x". When I have completed this task I move down the number of lines that I moved up to get to Heading 1, which may be many pages.
As you can imagine this is awkward, takes a long time (sometimes 60+ seconds) and is visually disturbing.
The code below is that subroutine that identifies the heading.
Dim str_heading_txt, hdgn_STYLE As String
Dim SELECTION_PG_NO as Integer
hdng_STYLE = Selection.Style
Do Until Left(hdng_STYLE, 7) = "Heading"
LINESUP = LINESUP + 1
Selection.MoveUp Unit:=wdLine, COUNT:=1
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
hdng_STYLE = Selection.Style
'reached first page without finding heading
SELECTION_PG_NO = Selection.Information(wdActiveEndPageNumber)
If SELECTION_PG_NO = 1 Then 'exit if on first page
a_stop = True
Exit Sub
End If
Loop
str_heading_txt = Selection.Sentences(1)
I tried another approach below in order to eliminate the scrolling and performance issues using the Range.Find command below.
I am having trouble getting the selection range to move to the text with the "Heading 1" style. The code selects the sentence at the initial selection, not the text with the "Heading 1" style.
Ideally the Find command would take me to any style that contained "Heading" but, if required, I can code separately for "Heading 1", "Heading 2" and "Heading 3".
What changes to the code are required so that "Heading 1" is selected or, alternatively, that "Heading" is selected?
Dim str_heading_txt, hdgn_STYLE As String
Dim Rng As Range
Dim Fnd As Boolean
Set Rng = Selection.Range
With Rng.Find
.ClearFormatting
.Style = "Heading 1"
.Forward = False
.Execute
Fnd = .Found
End With
If Fnd = True Then
With Rng
hdng_STYLE = Selection.Style
str_heading_txt = Selection.Sentences(1)
End With
End If
Any assistance is sincerely appreciated.
You can use the range.GoTo() method.
Dim rngHead As Range, str_heading_txt As String, hdgn_STYLE As String
Set rngHead = Selection.GoTo(wdGoToHeading, wdGoToPrevious)
'Grab the entire text - headers are considered a paragraph
rngHead.Expand wdParagraph
' Read the text of your heading
str_heading_txt = rngHead.Text
' Read the style (name) of your heading
hdgn_STYLE = rngHead.Style
I noticed that you used Selection.Sentences(1) to grab the text, but headings are already essentially a paragraph by itself - so you can just use the range.Expand() method and expand using wdParagraph
Also, a bit of advice:
When declaring variables such as:
Dim str_heading_txt, hdgn_STYLE As String
Your intent was good, but str_heading_txt was actually declared as type Variant. Unfortunately with VBA, if you want your variables to have a specific data type, you much declare so individually:
Dim str_heading_txt As String, hdgn_STYLE As String
Or some data types even have "Shorthand" methods known as Type Characters:
Dim str_heading_txt$, hdgn_STYLE$
Notice how the $ was appended to the end of your variable? This just declared it as a String without requiring the As String.
Some Common Type-Characters:
$ String
& Long
% Integer
! Single
# Double
You can even append these to the actual value:
Dim a
a = 5
Debug.Print TypeName(a) 'Prints Integer (default)
a = 5!
Debug.Print TypeName(a) 'Prints Single
Try something based on:
Sub Demo()
Dim Rng As Range, StrHd As String, s As Long
s = 10
With Selection
Set Rng = .Range
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
StrHd = Rng.Paragraphs.First.Range.Text
Do While Right(Rng.Paragraphs.First.Style, 1) > 1
Rng.End = Rng.Start - 1
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
With Rng.Paragraphs.First
If Right(.Style, 1) < s Then
s = Right(.Style, 1)
StrHd = .Range.Text & StrHd
End If
End With
Loop
MsgBox StrHd
End With
End Sub
I'm working on a Powerpoint slide, where I few texts are listed. I have to search for these texts in a Word Document which has a lot of Headings and Texts. After I find the title text, I need to copy the text under the Heading and paste in a new document.
Basically, the VBA coding has to be done in the Powerpoint VBA, with two documents in the background for searching text and pasting it in another.
I've opened the word doc. But searching the text in it and selecting it for copying to another document is what I've not been able to do. Kindly help me.
I see. The following is not exactly elegant since it uses Selection which I always try to avoid but it is the only way I know to achieve such a thing.
Disclaimer 1: this is made in Word VBA, so you will need a slight adaption, like set a reference to Word, use a wrdApp = New Word.Application object and declare doc and newdoc explicitely as Word.Document.
Disclaimer 2: Since you search for text instead of the respective heading, beware that this will find the first occurence of that text so you better not have the same text in several chapters. ;-)
Disclaimer 3: I cannot paste anymore! :-( My clipboard is set, it pastes elsewhere but I just cannot paste in here.
Code follows with first edit, hopefully in a minute...
Edit: yepp, pasting works again. :-)
Sub FindChapter()
Dim doc As Document, newdoc As Document
Dim startrange As Long, endrange As Long
Dim HeadingToFind As String, ChapterToFind As String
ChapterToFind = "zgasfdiukzfdggsdaf" 'just for testing
Set doc = ActiveDocument
Set newdoc = Documents.Add
doc.Activate
Selection.HomeKey unit:=wdStory
With Selection
With .Find
.ClearFormatting
.Text = ChapterToFind
.MatchWildcards = False
.MatchCase = True
.Execute
End With
If .Find.Found Then
'**********
'Find preceding heading to know where chapter starts
'**********
.Collapse wdCollapseStart
With .Find
.Text = ""
.Style = "Heading 1"
.Forward = False
.Execute
If Not .Found Then
MsgBox "Could not find chapter heading"
Exit Sub
End If
End With
.MoveDown Count:=1
.HomeKey unit:=wdLine
startrange = .Start
'*********
'Find next heading to know where chapter ends
'*********
.Find.Forward = True
.Find.Execute
.Collapse wdCollapseStart
.MoveUp Count:=1
.EndKey unit:=wdLine
endrange = .End
doc.Range(startrange, endrange).Copy
newdoc.Content.Paste
newdoc.SaveAs2 doc.Path & "\" & HeadingToFind & ".docx", wdFormatFlatXML
Else
MsgBox "Chapter not found"
End If
End With
End Sub
Edit: If you need to search for a "feature" that will be in some table in column 1 with the description in column 2 and you need that description in a new doc, try this:
Sub FindFeature()
Dim doc As Document, newdoc As Document
Dim FeatureToFind As String
Dim ro As Long, tbl As Table
FeatureToFind = "zgasfdiukzfdggsdaf" 'just for testing
Set doc = ActiveDocument
Set newdoc = Documents.Add
doc.Activate
Selection.HomeKey unit:=wdStory
With Selection
With .Find
.ClearFormatting
.Text = FeatureToFind
.MatchWildcards = False
.MatchCase = True
.Execute
End With
If .Find.Found Then
Set tbl = Selection.Tables(1)
ro = Selection.Cells(1).RowIndex
tbl.Cell(ro, 2).Range.Copy
newdoc.Range.Paste
End If
End With
End Sub
Edit: Slight adaptation so you can paste without overwriting existing content in newdoc:
Instead of newdoc.Range.Paste just use something along the line of this:
Dim ran As Range
Set ran = newdoc.Range
ran.Start = ran.End
ran.Paste
I am pulling text from another application and creating a MS-Word document on the fly.
Occasionally there may be some highlighting of words needed which I perform as I find these. What I cannot understand is how to cease displaying the HighlightColorIndex.
I've tried Selection.Collapse, Selection.Range.Collapse and Selection.Range.HighlightColorIndex = wdNoHighlight all to limited success. Can you assist please?
Dim lngRangeStart As Long
Dim lngRangeEnd As Long
Selection.TypeText Text:="Test of colour" ' No highlighting at present
Selection.TypeParagraph '
Selection.TypeText Text:="Starting colour after colon: " ' No highlighting at present
lngRangeStart = Selection.Start ' set to the start of the Range
Selection.Range.StartOf
Selection.TypeText Text:="This text is highlighted"
lngRangeEnd = Selection.Start ' set to the end of the Range and sel.start appears correct
Selection.SetRange Start:=lngRangeStart, End:=lngRangeEnd ' sets range correctly
Selection.Range.HighlightColorIndex = wdYellow
' >>> This is where I need to cease highlighting but what to do?
{funky code to stop highlighting here}
Selection.TypeText Text:="Now back to clear text"
You need to select text as you did before and reset its highlight to none wdNoHighlight
Use below code
' >>> This is where I need to cease highlighting but what to do?
'{funky code to stop highlighting here}
Selection.Move WdUnits.wdCharacter, 1
''Clear for text
lngRangeStart = Selection.Start
Selection.TypeText text:="Now back to clear text"
lngRangeEnd = Selection.Start
Selection.SetRange Start:=lngRangeStart, End:=lngRangeEnd ' sets range correctly
Selection.Range.HighlightColorIndex = wdNoHighlight
Selection.Move WdUnits.wdCharacter, 1
Selection.TypeText text:="Now back to the future text"
If I understand your question correctly, then you just set the highlight color to wdColorAutomatic, which is a constant specifying the automatic (default) color.
So putting it all together, to highlight text, you'd set its background to wdColorYellow. To remove the highlighting, you'd set its background to wdColorAutomatic.