|
|
|
date: Thu, 28 Aug 2008 11:52:22 -0700 (PDT),
group: microsoft.public.word.vba.beginners
back
Looking for suggestions how to make my functional but ugly hack job
code elegant
Hello all;
First time poster here. What I'm trying to do is search through a
document targeting on a keyword (entered by the user). When the
keyword is found, the code then uses the Extend and wdMove objects to
Select the sentence that the key word is in copy it and paste it at
the bottom of the document.
The code below works, but is definitely newbie hack code. I'm sure
that there is a much more elegant way to do this. I would appreciate
any suggestions. I'm much better at VBA for Excel.
Also looking for;
Once I find the sentence I want, I would like to then scan up in the
document to where a style change is and copy that also. (Heading 3
vs. Normal)
Example: search word = "shall"
Desired result
2.3.1 Byte Control Parameter <tab> When the Byte Control Parameter is
False the system shall send BCPerror to Master <vbCr>
'''''''''''''''''''
' Code Begins
''''''''''''''''''
Public Sub Gobbeldygook()
Dim strSearch As String
strSearch = InputBox$("Type in the text you want to search for.")
Dim iCount As Long
Dim jCount As Long
iCount = 0
Selection.HomeKey Unit:=wdStory
Selection.HomeKey Unit:=wdStory
With ActiveDocument.Content.Find
.Text = strSearch
.Format = False
.Wrap = wdFindStop
'Uses Do While here
Do While .Execute
iCount = iCount + 1
Loop '
End With
crap = MsgBox(iCount, vbOKOnly)
If iCount = 0 Then
End
End If
jCount = 0
With ActiveDocument.Content.Find
.ClearFormatting
Do While .Execute(FindText:=strSearch, Forward:=True, _
Format:=True) = True
With .Parent
.StartOf Unit:=wdSentence, Extend:=wdMove
'.InsertAfter vbCr
.EndOf Unit:=wdSentence, Extend:=wdExtend
.Select
.Copy
.Move Unit:=wdSentence, Count:=1
.Bold = True
End With
strRetTextName = Selection.Text & vbCr
Selection.EndKey Unit:=wdStory
Selection.Text = strRetTextName
Selection.Paste
'
jCount = jCount + 1
If jCount = iCount Then
crap = MsgBox(jCount, vbOKOnly)
End
End If
Loop
End With
crap = MsgBox(iCount, vbOKOnly)
End Sub
date: Thu, 28 Aug 2008 11:52:22 -0700 (PDT)
author: -W
RE: Looking for suggestions how to make my functional but ugly hack jo
To: W,
The first part of your task is easy enough:
Sub FindSentenceOfKeyWordOrPhrase()
Dim key As String
Dim str As String
Dim list As String
Dim oRange As Range
Set oRange = ActiveDocument.Range
key = InputBox$("Type in the text you want to search for.")
With oRange.Find
.ClearFormatting
.Forward = True
.Format = True
.Text = key
.Wrap = wdFindStop
.Execute
While .Found = True
str = oRange.Sentences(1).Text
'check to see if a sentence is found.
If InStr(1, str, key) > 0 Then
list = list & str & vbCr
End If
.Execute
Wend
End With
MsgBox list
End Sub
If you're still interested, I'll put some thought in finding the Heading 3
preceeding each found word. You Heading 3 doesn't start a new section does it?
Steven Craig Miller
"-W" wrote:
> Hello all;
>
> First time poster here. What I'm trying to do is search through a
> document targeting on a keyword (entered by the user). When the
> keyword is found, the code then uses the Extend and wdMove objects to
> Select the sentence that the key word is in copy it and paste it at
> the bottom of the document.
>
> The code below works, but is definitely newbie hack code. I'm sure
> that there is a much more elegant way to do this. I would appreciate
> any suggestions. I'm much better at VBA for Excel.
>
> Also looking for;
> Once I find the sentence I want, I would like to then scan up in the
> document to where a style change is and copy that also. (Heading 3
> vs. Normal)
>
> Example: search word = "shall"
>
> Desired result
> 2.3.1 Byte Control Parameter <tab> When the Byte Control Parameter is
> False the system shall send BCPerror to Master <vbCr>
>
> '''''''''''''''''''
> ' Code Begins
> ''''''''''''''''''
> Public Sub Gobbeldygook()
>
> Dim strSearch As String
> strSearch = InputBox$("Type in the text you want to search for.")
>
>
> Dim iCount As Long
> Dim jCount As Long
>
> iCount = 0
> Selection.HomeKey Unit:=wdStory
>
> Selection.HomeKey Unit:=wdStory
> With ActiveDocument.Content.Find
> .Text = strSearch
> .Format = False
> .Wrap = wdFindStop
> 'Uses Do While here
> Do While .Execute
> iCount = iCount + 1
> Loop '
> End With
> crap = MsgBox(iCount, vbOKOnly)
>
> If iCount = 0 Then
> End
> End If
>
> jCount = 0
> With ActiveDocument.Content.Find
> .ClearFormatting
> Do While .Execute(FindText:=strSearch, Forward:=True, _
> Format:=True) = True
> With .Parent
> .StartOf Unit:=wdSentence, Extend:=wdMove
> '.InsertAfter vbCr
> .EndOf Unit:=wdSentence, Extend:=wdExtend
> .Select
> .Copy
> .Move Unit:=wdSentence, Count:=1
> .Bold = True
> End With
> strRetTextName = Selection.Text & vbCr
> Selection.EndKey Unit:=wdStory
> Selection.Text = strRetTextName
> Selection.Paste
> '
> jCount = jCount + 1
> If jCount = iCount Then
> crap = MsgBox(jCount, vbOKOnly)
> End
> End If
> Loop
> End With
> crap = MsgBox(iCount, vbOKOnly)
> End Sub
>
>
date: Fri, 29 Aug 2008 13:24:17 -0700
author: StevenM stevencraigmiller(at)comcast(dot)net
Re: Looking for suggestions how to make my functional but ugly hack
jo
On Aug 29, 4:24 pm, StevenM <stevencraigmiller(at)comcast(dot)net>
wrote:
> To: W,
>
> The first part of your task is easy enough:
>
> Sub FindSentenceOfKeyWordOrPhrase()
> Dim key As String
> Dim str As String
> Dim list As String
> Dim oRange As Range
>
> Set oRange = ActiveDocument.Range
> key = InputBox$("Type in the text you want to search for.")
> With oRange.Find
> .ClearFormatting
> .Forward = True
> .Format = True
> .Text = key
> .Wrap = wdFindStop
> .Execute
>
> While .Found = True
> str = oRange.Sentences(1).Text
> 'check to see if a sentence is found.
> If InStr(1, str, key) > 0 Then
> list = list & str & vbCr
> End If
> .Execute
> Wend
> End With
> MsgBox list
> End Sub
>
> If you're still interested, I'll put some thought in finding the Heading 3
> preceeding each found word. You Heading 3 doesn't start a new section does it?
>
> Steven Craig Miller
>
>
>
> "-W" wrote:
> > Hello all;
>
> > First time poster here. What I'm trying to do is search through a
> > document targeting on a keyword (entered by the user). When the
> > keyword is found, the code then uses the Extend and wdMove objects to
> > Select the sentence that the key word is in copy it and paste it at
> > the bottom of the document.
>
> > The code below works, but is definitely newbie hack code. I'm sure
> > that there is a much more elegant way to do this. I would appreciate
> > any suggestions. I'm much better at VBA for Excel.
>
> > Also looking for;
> > Once I find the sentence I want, I would like to then scan up in the
> > document to where a style change is and copy that also. (Heading 3
> > vs. Normal)
>
> > Example: search word = "shall"
>
> > Desired result
> > 2.3.1 Byte Control Parameter <tab> When the Byte Control Parameter is
> > False the system shall send BCPerror to Master <vbCr>
>
> > '''''''''''''''''''
> > ' Code Begins
> > ''''''''''''''''''
> > Public Sub Gobbeldygook()
>
> > Dim strSearch As String
> > strSearch = InputBox$("Type in the text you want to search for.")
>
> > Dim iCount As Long
> > Dim jCount As Long
>
> > iCount = 0
> > Selection.HomeKey Unit:=wdStory
>
> > Selection.HomeKey Unit:=wdStory
> > With ActiveDocument.Content.Find
> > .Text = strSearch
> > .Format = False
> > .Wrap = wdFindStop
> > 'Uses Do While here
> > Do While .Execute
> > iCount = iCount 1
> > Loop '
> > End With
> > crap = MsgBox(iCount, vbOKOnly)
>
> > If iCount = 0 Then
> > End
> > End If
>
> > jCount = 0
> > With ActiveDocument.Content.Find
> > .ClearFormatting
> > Do While .Execute(FindText:=strSearch, Forward:=True, _
> > Format:=True) = True
> > With .Parent
> > .StartOf Unit:=wdSentence, Extend:=wdMove
> > '.InsertAfter vbCr
> > .EndOf Unit:=wdSentence, Extend:=wdExtend
> > .Select
> > .Copy
> > .Move Unit:=wdSentence, Count:=1
> > .Bold = True
> > End With
> > strRetTextName = Selection.Text & vbCr
> > Selection.EndKey Unit:=wdStory
> > Selection.Text = strRetTextName
> > Selection.Paste
> > '
> > jCount = jCount 1
> > If jCount = iCount Then
> > crap = MsgBox(jCount, vbOKOnly)
> > End
> > End If
> > Loop
> > End With
> > crap = MsgBox(iCount, vbOKOnly)
> > End Sub- Hide quoted text -
>
> - Show quoted text -
thank you for this code. I'll try it today
For the headings, they usually don't match up to a section break
Regards
-W
date: Tue, 2 Sep 2008 07:10:01 -0700 (PDT)
author: -W
Re: Looking for suggestions how to make my functional but ugly hac
"-W" wrote:
<snip>
> thank you for this code. I'll try it today
>
> For the headings, they usually don't match up to a section break
Try this variation of Steven's code:
_________________________
Option Explicit
Sub FindSentenceOfKeyWord()
Dim strKey As String
Dim rgeDoc As Range
Dim rgeDocEnd As Range
Dim lngOrigin As Long
Set rgeDoc = ActiveDocument.Range
Set rgeDocEnd = ActiveDocument.Range
lngOrigin = rgeDocEnd.End
Do While Trim(strKey) = ""
strKey = InputBox$("Type in the text you want to search for.")
Loop
With rgeDoc.Find
.ClearFormatting
Do While .Execute(FindText:=strKey, Forward:=True, _
Wrap:=wdFindStop)
With rgeDocEnd
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
rgeDocEnd.FormattedText = .Parent _
.Sentences(1).FormattedText
FindHeading .Parent.Duplicate, rgeDocEnd
If rgeDoc.End >= lngOrigin Then Exit Do
rgeDoc.Start = rgeDoc.End
rgeDoc.End = lngOrigin
Loop
End With
If rgeDocEnd.End = lngOrigin Then
MsgBox "The expression """ & strKey & """ was not found in the " _
& "document.", vbExclamation, "Text not found"
End If
End Sub
Sub FindHeading(ByVal rgeTarget As Range, _
ByRef rgeEnd As Range)
rgeTarget.Collapse wdCollapseStart
rgeTarget.Select
With rgeEnd
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
With rgeTarget.Find
.ClearFormatting
.Forward = False
.Text = ""
.Style = ActiveDocument.Styles("Heading 3")
If .Execute Then
rgeEnd.FormattedText = .Parent.FormattedText
Exit Sub
Else
rgeEnd.Text = "No instance of ""Heading 3"" " _
& "was found previous to that sentence"
End If
End With
End Sub
___________________________________
Note that you cannot use "Cancel" in the InputBox. This is becasue the
"Cancel" button returns an empty string. But to avoid errors, you also need
to check against empty strings... So the compiler cannot tell if the empty
string is an "empty" InputBox where the user clicked on "OK" or if it is the
result of using the "Cancel" button.
If you want to cancel, just type non-sensical characters in the InputBox
(Such as that they will not be found in the document.)
date: Thu, 4 Sep 2008 11:52:00 -0700
author: Jean-Guy Marcil
|
|
