PDA

View Full Version : Solved: Find function reaches end



lawtai
08-16-2005, 12:06 PM
If I'm using the Find function in word with the Selection.Find.Execute command, and it's a repetitive search, how can I code it so that it recognizes when it's searched the entire document? I am currently using this code:


Sub SelectRange()
'
' Extract Macro
' Macro recorded 8/16/2005 by ltai
'
Dim Charpos1 As Long
Dim Charpos2 As Long
Dim CharposEnd As Long
ActiveDocument.Bookmarks("\StartofDoc").Select
CharposEnd = EndofDoc

Do Until CharposEnd = 1
Selection.Find.Execute "("
Selection.MoveRight Unit:=wdCharacter, Count:=1
Charpos1 = Selection.Range.Start
'Selection.Collapse
Selection.Find.Execute ")"
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Charpos2 = Selection.Range.End
ActiveDocument.Range(Start:=Charpos1, End:=Charpos2).Select
Selection.Font.italic = wdToggle
Selection.Range.Copy
Selection.Font.italic = wdToggle
Selection.Collapse
Windows("test.doc").Activate
Selection.PasteAndFormat (wdPasteDefault)
Windows("Test Plans.doc").Activate
Loop
End Sub


Any help would be appreciated! Thanks!

mdmackillop
08-16-2005, 12:31 PM
How about
Do
If Selection.Find.Execute("(") = False Then Exit Sub

fumei
08-16-2005, 01:04 PM
Here is a better way.
Sub BetweenBrackets()
Dim oRange As Word.Range
Dim strToBeCopied As String

Selection.HomeKey unit:=wdStory
With Selection.Find
Do While (.Execute(findtext:="(", Forward:=True) _
= True = True)
Selection.Collapse Direction:=wdCollapseEnd
Set oRange = Selection.Range
With oRange
.MoveEndUntil cset:=")", Count:=wdForward
strToBeCopied = oRange.Text
Documents("Test Plan.doc").Activate
With Selection
.EndKey unit:=wdStory
.TypeText Text:=strToBeCopied & vbCrLf
End With
Documents("Brackets.doc").Activate
End With
Set oRange = Nothing
Loop
End With
End Sub

This is firing from a document called "brackets.doc", but copies everything between brackets to the document "Test Plan.doc". So, as these are hard coded, and ASSUMED to be opened, be careful. Proper coding would not do this, but i want to show principles of Find here.

1. go to start of doc
2. start a loop based on that .execute = true IS true, the text it is executing the search for is "("
3. while that remains True (that is, that .execute = true = true....weird I know), collapse selection.found to the end. Thus just to the right of "(".
4. make a range object of the selection range
5. move the Range end unitl ")" is found
6. make a string variable = the range.Text

Remember NOTHING has changed with the current selection and its Find processing! This just use the Selection.Find to start the creation, then exntenion of the range object.

7. Activate the other doc
8. go to the end of that doc
9. dump the string variable, plus a carriage return to make a new line
10 go back to the opriginal doc
11 destroy the range object
12 continue on to the search

The search ends when .execute = true = false, and since you start at the start of the document it runs until it no longers finds a "(".

fumei
08-16-2005, 01:06 PM
Actually, it would be better to destroy the range object earlier I guess. You could set oRange = Nothing right after you dump its .Text into the string variable.

fumei
08-16-2005, 01:08 PM
Note also that using the .MoveEndUntil on the Range object free up resources on the Selection - as you are not using it - and it will find the FIRST ")". Very convenient.

fumei
08-16-2005, 01:11 PM
oooops, I forgot the italic business....

replace.EndKey unit:=wdStory
.TypeText Text:=strToBeCopied & vbCrLf
with:
.EndKey unit:=wdStory
.Font.Italic = True
.TypeText Text:=strToBeCopied & vbCrLf

fumei
08-16-2005, 01:19 PM
I am sending too darn fast.

Other note! This should be error trapped better. A variant should be made on the success of .MoveEndUntil CSet:=")". In other words, it should be error trapped so that IF a "(" is found, but the corresponding ")" is NOT found - hey we all make mistakes... - then either a request for clarification is made to the user, OR it is ignored. Further error trapping thoughts:

what if the end brackets is, shall we say an unreasonable distance?

say it should be

blahblah (this blah) and then blah blah blah. blahblah blahblah (this blah).

Copies TWO instances of "this blah"

But instead, someone forgot ONE of ther brackets.

blahblah (this blah and then blah blah blah. blahblah blahblah (this blah).

Then the code will copy text from the FIRST "(" to the FIRST ")" =

"this blah and then blah blah blah. blahblah blahblah (this blah"

Perhaps a check on Len(strToBeCopied), so if the string is ridiculously long, or rather suspiciously long, the routine quits, or asks for assistance?

lawtai
08-16-2005, 01:26 PM
Thanks for your help! Since I posted, I found out that the following code seems to work:

Do Until ActiveDocument.Bookmarks("\Sel") = _
ActiveDocument.Bookmarks("\EndOfDoc")
Selection.Find.ClearFormatting
Selection.Find.Execute "("
If Selection.Find.Found = False Then
Exit Do
End If
Selection.MoveRight Unit:=wdCharacter, Count:=1
Charpos1 = Selection.Range.Start
'Selection.Collapse
Selection.Find.Execute ")"
If Selection.Find.Found = False Then
Exit Do
End If
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Charpos2 = Selection.Range.End
ActiveDocument.Range(Start:=Charpos1, End:=Charpos2).Select
Selection.Font.italic = wdToggle
Selection.Range.Copy
Selection.Font.italic = wdToggle
Selection.Collapse
Selection.EndKey Unit:=wdLine, Extend:=wdMove
Windows("test.doc").Activate
Selection.PasteAndFormat (wdPasteDefault)
Windows("Regression Test Plans Revised.doc").Activate
Loop

Not as pretty and probably not the best programming methods but atleast I understand it. I'll try to incorporate your code into it or better programming means.


Now I have another question though... The line that the Parentheses are on is a Numbered line which is being controled through Word. How can I grab the number that's assigned to the line?

Example

1. random text here (Copied Text)

I basically want to grab the 1 as well as the Copied Text, but the 1 is being controlled through Word and I can't just copy and paste it since it's in a long list of numbers.

Thanks again!

TonyJollans
08-16-2005, 01:28 PM
I really prefer to be more explicit in setting the properties of the Find object but, more to the point, isn't it easier to Find a complete parenthesised string all at once, something along these lines (untested) ..

:
:
With Selection.Find
.Wrap = wdFindStop
.MatchWildcards = True
Do While .Execute(findtext:="\(*\)", Forward:=True)
strToBeCopied = Mid$(Selection.Range.Text, 2, Len(Selection.Range.Text) - 2)
Documents("Test Plan.doc").Activate
With Selection
.EndKey unit:=wdStory
.TypeText Text:=strToBeCopied & vbCrLf
End With
Documents("Brackets.doc").Activate
End With
Loop
End With
:
:

I don't know what to make of the toggling of italics - are they wanted on or off - or do you really always want the inverse of the original?

mdmackillop
08-16-2005, 01:34 PM
Hi Tony,
Toggling puts italic copy into the other document and restores the original

lawtai
08-16-2005, 01:40 PM
Now I have another question though... The line that the Parentheses are on is a Numbered line which is being controled through Word. How can I grab the number that's assigned to the line?

Example

1. random text here (Copied Text)

I basically want to grab the 1 as well as the Copied Text, but the 1 is being controlled through Word and I can't just copy and paste it since it's in a long list of numbers.

Thanks again!

TonyJollans
08-16-2005, 01:45 PM
Hi Malcolm,

Well, it depends on what you have to start with.

lawtai's original code will not (necessarily) leave the original document unchanged and may create a new doc with a mixture of italics and non-italics - and Gerry's code will always set italics in the new document while leaving the original unchanged. I just wanted to query the intent :)

mdmackillop
08-16-2005, 01:47 PM
footinmout You're right of course!

fumei
08-16-2005, 02:05 PM
Gerry's code set the typed text as italics, as the apparent intent was the text copied to the new document was to be italics.

I specifically did NOT use toggle on the original, as I generally find toggling is badly used. It is too easily not toggled back, plus there is no need to toggle....unless you want the text in italics...and there is STILL no need to toggle...just make it italics.

However, Tony is correct as usual, and in effect I DID do a toggle, as I left the Selection object .Font as italics.

Tony is also correct, yes, absolutely it is better to have the whole string, and has a nice slick snippet there.

RE: line numbers.......eheu, yuck yuck.....I am going home.

TonyJollans
08-16-2005, 04:44 PM
OK, I'll tackle the numbers ..

To do this properly requires a bit more checking, but after a successful Find ...

With Selection.Paragraphs(1).Range.ListFormat
If Not .List Is Nothing Then TheNumberYouWantShouldBe = .ListValue
End With

TonyJollans
08-16-2005, 04:49 PM
Also, it (now) seems as though the original text is italic and the intent is to remove the italicisation; if so, it should happen automatically simply by taking the Text without the formatting.

fumei
08-16-2005, 11:39 PM
Just be darn sure:

a) you do not change line numbering in the document
b) you are using Styles. if you are NOT using styles for paragraph spacing - that is, you are using those "extra" Enter keys to make space between paragraphs - then each of those counts as a line.

eheu eheu yuck yuck

lawtai
08-17-2005, 04:01 AM
thanks for the help with the line numbering! I'll have to add it and see how it works.

I'm currently not using styles, and am instead using "extra" Enter keys to place all my lines.

lawtai
08-17-2005, 05:08 AM
I was able to get the line numbering to work! thanks!

A question about the styling though. I have used styles on my titles by using "Heading 3" on the titles. How can I also print out the titles? Sorry if I'm asking too many questions. I've found out how I can search for a certain style, but since the titles are all going to have different names without any unifying characters, I'm at a loss to how I would go about copying them as well.

lawtai
08-17-2005, 05:18 AM
Sorry for the load of questions, but is there a good source online that you guys use to help you with other than this site?

TonyJollans
08-17-2005, 06:37 AM
Hi lawtai,

I'm afraid I don't understand your question. You say you have found out that you can search for a style - so do it!! What else do you think you might want?

If you are trying to incorporate heading details into your original search there isn't any simple way to do it - one way or another you're looking to interweave two searches.

My main source of information is Word itself (and its Help). I read, I poke around, I try things out, ... you can do it, too. Word's object model is not the easiest to get into but if you're going to work with it you have no real choice. There are a handful of web sites (mostly belonging to MS MVPs) with some good information on Word (try Googling) but none I use regularly and none that I know really focus on VBA I haven't a clue about any books, I'm afraid (Excel and Access are well served, Word not so well, I think).

lawtai
08-17-2005, 06:44 AM
Thanks for the response!

I know how to search limiting to certain styles, but the thing is, with the way my document is set up, there are no common recurring characters/symbols that show up in the title. Basically, everytime I'm using "heading 3" it'll be a new title.

This code is basically trying to help me solve the following post I made earlier which is in this thread:
http://www.vbaexpress.com/forum/showthread.php?t=4645

With what I have so far, I think I have 40% of it done.

All I really need to do now is figure out how to copy the title, in the sequence it appears with my other searches, and then paste it all into tables...a new table everytime a new title appears.

I was thinking along what you mentioned of having concurrent searches, although I'm still trying to grasp the code involved. I think I would basically need to find a way to scan the document from top to bottom...Any more help would be greatly appreciated!

Thanks again for all the help you've already given.

The following code is what I have so far, and I am able to populate cells. Now I just need to figure out how to tell it to break and create a new table and insert the header when it appears.

Sub BetweenBrackets()
Dim oRange As Word.Range
Dim strToBeCopied As String
Dim NameFile As String

CounterA = 1
NameFile = "testlog" & CounterA & ".doc"
CounterA = CounterA + 1

Documents.Add DocumentType:=wdNewBlankDocument
ActiveDocument.SaveAs FileName:=NameFile

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=5, NumColumns:= _
5, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.TypeText Text:="Steps"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Description"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Pass"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Fail"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Comments"
Selection.MoveRight Unit:=wdCell

Documents("Regression Test Plans Revised.doc").Activate

Selection.HomeKey Unit:=wdStory
With Selection.Find
Do While (.Execute(findtext:="(", Forward:=True) _
= True = True)
Selection.Collapse Direction:=wdCollapseEnd
Set oRange = Selection.Range
With oRange
.MoveEndUntil cset:=")", Count:=wdForward
strToBeCopied = oRange.Text
With Selection.Paragraphs(1).Range.ListFormat
If Not .List Is Nothing Then TheNumberYouWantShouldBe = .ListValue
End With
Documents(NameFile).Activate
With Selection
' .EndKey Unit:=wdStory
.TypeText Text:=TheNumberYouWantShouldBe '& " " & strToBeCopied & vbCrLf
Selection.MoveRight Unit:=wdCell
.TypeText Text:=strToBeCopied
Selection.MoveRight Unit:=wdCell, Count:=4
End With
Documents("Test Plans.doc").Activate
End With
Set oRange = Nothing
Loop
End With
End Sub

TonyJollans
08-17-2005, 06:55 AM
1. You can search for a style without specifying any text.

2. Word can get in a bit of a mess if you try and run two searches in parallel. I would (probably) build an array of the headings first and then check it to find the 'current heading' each time the other search found a result.

3. I haven't time to look at your code in detail at the moment. Will do so later.

lawtai
08-17-2005, 06:56 AM
Here's an idea I have, I was wondering if it's possible.

Since I'm already storing the line number, what if I compared the line number to the previous line number. If the new line number was smaller, then I would go and find the title, break out of the table being populated, paste title, create new table and repopulate table?

heh, If none of that makes sense, just let me know.

* Ah ok, I understand the find style function now, thanks!

** hmm, this might not work since the numbers in the next section might actually be starting higher than the numbers that it finished on in the previous section...

lawtai
08-18-2005, 06:56 AM
Thanks again for all the help, I've been able to get my code working how I want it to, for the most part.

TonyJollans
08-18-2005, 07:05 AM
Good news!

Sorry I didn't get back to looking at your code sooner.

lawtai
08-18-2005, 08:57 AM
no problem. thanks for the help in the first place. If possible, do you think you can look at this code and see how I can clean it up some? Or if it's good as is?


Dim StoreHeader As String
Sub BetweenBrackets()
Dim oRange As Word.Range
Dim strToBeCopied As String
Dim NewFile As String
Dim MasterFile As String
Dim FirstHeader As String
CounterA = 1
NewFile = "testlog" & CounterA & ".doc"
CounterA = CounterA + 1
PreviousNumber = 0
MasterFile = ActiveDocument.FullName
Ttlpgs = Selection.Information(wdNumberOfPagesInDocument)
PrevPage = 1

Documents.Add DocumentType:=wdNewBlankDocument
ActiveDocument.SaveAs FileName:=NewFile
Documents(MasterFile).Activate
Selection.HomeKey Unit:=wdStory
SearchHeader
FirstHeader = StoreHeader
Documents(NewFile).Activate
Selection.PasteAndFormat (wdPasteDefault)
Createtable
Documents(MasterFile).Activate
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Wrap = wdFindStop
.MatchWildcards = True
Do While .Execute(findtext:="\{*\}", Forward:=True)
strToBeCopied = Mid$(Selection.Range.Text, 2, Len(Selection.Range.Text) - 2)
With Selection.Paragraphs(1).Range.ListFormat
If Not .List Is Nothing Then TheNumberYouWantShouldBe = .ListValue
CurPage = Selection.Information(wdActiveEndPageNumber)
If CurPage <> PrevPage Then
Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=CurPage, Name:=""
ActiveDocument.Bookmarks("\page").Select
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 3")
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Range.Style <> "Heading 3" Then GoTo LabelPaste
Selection.Find.Style = ActiveDocument.Styles("Normal")

Documents(NewFile).Activate
Selection.Rows.Delete
Selection.MoveDown Unit:=wdLine
Selection.TypeParagraph

Documents(MasterFile).Activate
ActiveDocument.Bookmarks("\Page").Select
Selection.Collapse
SearchHeader
If StrComp(FirstHeader, StoreHeader, vbBinaryCompare) = 0 Then GoTo Breakloop
Documents(NewFile).Activate
Selection.PasteAndFormat (wdPasteDefault)
Createtable
GoTo LabelA
End If
End With

Documents(NewFile).Activate
With Selection
.TypeText Text:=TheNumberYouWantShouldBe
Selection.MoveRight Unit:=wdCell
.TypeText Text:=strToBeCopied
Selection.MoveRight Unit:=wdCell, Count:=4
End With
LabelPaste:
Selection.Collapse
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Normal")
Selection.Find.MatchWildcards = True
LabelA:
PrevPage = CurPage
Documents(MasterFile).Activate
Loop
Breakloop:
End With
Documents(NewFile).Activate
ActiveDocument.Save

End Sub
Function SearchHeader()
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 3")
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
StoreHeader = Mid$(Selection.Range.Text, 1, Len(Selection.Range.Text) - 1)
Selection.Copy
Selection.Find.Style = ActiveDocument.Styles("Normal")
Selection.Find.MatchWildcards = True
End Function
Function Createtable()
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
5, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
Selection.TypeText Text:="Steps"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Description"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Pass"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Fail"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Comments"
Selection.MoveRight Unit:=wdCell

End Function

TonyJollans
08-18-2005, 11:37 AM
Hi lawtai,

At first look it seems over complex - and I'll post a bit more shortly - but it seems to make some assumptions about your "Heading 3" styles and pages and where it expects to find them; can you post a bit more detail of the document?

fumei
08-18-2005, 12:32 PM
This IS overly complex code.

Could you please post, step by step, exactly what you want to happen? No code, just exacly what you want it to do.

lawtai
08-18-2005, 12:35 PM
Well, the document that I'm running this macro against are test plans. 1 document will eventually have a good amount of test plans (possibly 100 pages or so). The main objective of the macro was to take the test plan and then create a log sheet that corresponds with the test plan document that could then be printed out and used as a checklist when following the steps on the test plan. I use the {} in my test plan to indicate a step that needs recording.

In order to create a log sheet, I needed to differentiate between where separate tests were starting since sometimes a test plan can run for 2-3 pages before the next test plan starts. The only easy way I found to start a new section on the test log with the header from the test plan, was to have it check whenever it reaches a new page whether or not there was any text using "heading 3" This lets me copy the header over if there is, or just continue to note the step # and whatever is in the {} on the test log.

The only time I'm using heading 3 in the test plan is with the Titles of the test plans.

I do agree that it seems pretty inefficient with how I'm doing it, but with my first run through, it's the most logical thing I could think of without doing a line by line check, and the code does work how I want it to. Any advice would be greatly appreciated! Thanks again!

fumei
08-18-2005, 01:57 PM
Let's walk it through, from a design point of view.

1. You have "chunks" of text (the tests).
2. each chunk (whether it is 1/2 page, or 3 pages...this, from a design point of view should NOT matter) starts with text using the Heading 3 style.

Here is where I want you to describe, EXACTLY what you want to happen. I am still not clear. MJy instincts say there is an easier way.

What are you DOING?

Do you want to extract each chunk? I am quite confused by the use of:

ActiveDocument.Bookmarks("\page").Select

Why on earth are you selecting the whole page, as an object?

Blah Blah Blah - this is in Heading 3 style

texttexttexttexttexttexttexttext, texttexttexttexttexttexttexttexttexttexttexttexttexttexttext
texttexttexttexttexttexttext

Blah Blah Blah - this is in Heading 3 style

texttexttexttexttexttexttexttext, texttexttexttexttexttexttexttexttexttexttexttexttexttexttext
texttexttexttexttexttexttext


OK, the textexttext part - from a design point of view it should NOT matter if it is 2 pages, 1 page or whatever.

Is this a good view of the document.

Walk me through EXACTLY what you want to happen. But first of all....use your own styles. Using heading 3 style is yucky. Word has itsd own personal thing with it. it is better to create and use your own.

So, do you want to grab the BlahBlahBlah AND the texttexttext?

Do you want to grab just the texttexttext?

Do you want to grab them separately?

In the new document, what, EXACTLY, is going in the table?

This could use proper Bookmarks, perhaps. if each of your test Titles was bookmarked - this (as far as I can tell) would be fairly easy. But then, again describe exactly what you want to happen.

Let's just assume that instead of heading 3 style, you made a TestStart style. it could look exactly like heading 3 if you want, but it is your own...hey be creative. Use it ONLY for the title of each test.

Then you run code to search for that style, and make bookmarks of them. NOW you have a way of distinquishing your parts.

You could use sections as well. it may or may not be the btter way. It is hard to say what is the best route to take, without seeing the document. In some ways, it does not matter. What DOES matter, is the design and purpose of the document, and your code.

lawtai
08-18-2005, 02:11 PM
heh, I'm mainly using the ActiveDocument.Bookmarks("\page").Select to move to the top of the page since I didn't know of better code to use.

My document will resemble something like this:

This is my title in Heading 3

Steps:
1. This is telling you what to do, don't grab this.
2. this is telling you to record something. {Grab This}
3. This is telling you what to do again, don't grab this.


This is what I want my log file to resemble, using the + sign as borders for the table:

This is my title in Heading 3

+Steps + Description + Pass + Fail + Comments+
+ 2 + Grab This + + + +

I'm only grabbing what's in the {} along with the step #, and the title.

I hope this makes it a little clearer. I thought of using bookmarks, but didn't want to have to mark up my test plan with a couple hundred bookmarks depending on how many test plans I had, which is why I wrote out my code like I did.

I can create a new style if that'll work better. I just used heading 3 since it matched what size font I originally had, heh.

TonyJollans
08-18-2005, 04:41 PM
Without wishing to be unkind, your code looks rather like you've just stumbled on something which happens to work for you rather than designing it. For example the code after label LabelPaste is sometimes done on one document, sometimes the other - it just so happens that it does no harm to the document it shouldn't be done on.

As a general rule, you should try and avoid using the Selection - particularly when, as here, you are flicking between documents. Other than that, although your intermingled Finds seem to work they are, as already said, rather over-complex.

If I understand what you're doing, I would step through the document paragraph by paragraph, copying the desired elements and ignoring the rest. I have knocked up a quick test and it appears to work but it's a mess and I will tidy it up beore posting it.

Gerry is absolutely right about your (original) document and its styles but it rather looks to me as though the Heading 3 style is the least of your worries if all your lists are just in Normal style.

TonyJollans
08-18-2005, 05:16 PM
OK, it still uses the Selection (but it is past my bedtime!) and wants a bit of tweaking but here's what I've got, based on what you posted. Let me know if it does what you want. As I said, it just rolls through the document looking for what you want and copying it.

Sub Tony()

Dim docMaster As Document
Set docMaster = ActiveDocument
Documents.Add

Dim P As Paragraph
For Each P In docMaster.Paragraphs

If P.Style = "Heading 3" Then

Selection.EndKey wdStory
Selection.Style = ActiveDocument.Styles("Heading 1")
Selection.TypeText P.Range.Text
Selection.Style = ActiveDocument.Styles("Normal")
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
With Selection.Tables.Add(Range:=Selection.Range, NumRows:=1, NumColumns:=5)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
.Cell(1, 1).Range.Text = "Steps"
.Cell(1, 2).Range.Text = "Description"
.Cell(1, 3).Range.Text = "Pass"
.Cell(1, 4).Range.Text = "Fail"
.Cell(1, 5).Range.Text = "Comments"
End With

Else

With P.Range.Duplicate
With .Find
.Text = "\{*\}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.ClearFormatting
End With
If .Find.Execute Then
strToBeCopied = .Text
Selection.InsertRowsBelow
If Not P.Range.ListFormat.List Is Nothing Then
Selection.Tables(1).Rows.Last.Cells(1).Range.Text = P.Range.ListFormat.ListValue
End If
Selection.Tables(1).Rows.Last.Cells(2).Range.Text = Mid$(.Text, 2, Len(.Text) - 2)
End If
End With

End If
Next

End Sub

lawtai
08-18-2005, 06:43 PM
heh yea, this goes to show how well I know VB programming. Thanks for helping me out. I basically went with what I had because it worked with what i had. I'll try to keep in mind the advice you guys have given the next time I work on some code. I did think about going through paragraphs, but I decided that since I was hitting enter every single line practically, there would be 100's of paragraphs, which was basically searching line by line (Also my knowledge was still limited)

I'll try out your code and see how it works. There were a few changes that I made to the code I had since I added a few more conditions to the test plan, such as certain sections having {{}} to mark out something, and also formatting the table widths, but that's just something minor.

Thanks again! I'll post back with a response on how it turns out.

lawtai
08-18-2005, 06:46 PM
heh, I just ran your code on my document and it worked great. Now I just gotta figure out how you're doing it :)

I've taken your code, and made the changes that I had made in mine after I posted. I am able to get the same results now with 1/4 the amount of code. The parts I added might not be the most efficient way to do it, but I can't think of another way to do it as of this moment.

Sub Test()

Dim docMaster As Document
Set docMaster = ActiveDocument
Documents.Add

Dim TestCheck As String
Dim Temp As String
Dim P As Paragraph
For Each P In docMaster.Paragraphs

If P.Style = "Heading 3" Then

Selection.EndKey wdStory
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.TypeText P.Range.Text
Selection.Style = ActiveDocument.Styles("Normal")
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Font.Bold = True
Selection.Font.Size = 11
With Selection.Tables.Add(Range:=Selection.Range, NumRows:=1, NumColumns:=5)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
.Cell(1, 1).Range.Text = "Step #"
.Cell(1, 1).PreferredWidth = 42
.Cell(1, 2).Range.Text = "Description"
.Cell(1, 2).PreferredWidth = 100
.Cell(1, 3).Range.Text = "Pass"
.Cell(1, 3).PreferredWidth = 34
.Cell(1, 4).Range.Text = "Fail"
.Cell(1, 4).PreferredWidth = 34
.Cell(1, 5).Range.Text = "Comments"
.Cell(1, 5).PreferredWidth = 230
End With

Else

With P.Range.Duplicate
With .Find
.Text = "\{*\}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.ClearFormatting
End With
If .Find.Execute Then
strToBeCopied = Mid$(.Text, 2, Len(.Text) - 2)
TestCheck = Mid$(strToBeCopied, 1, 1)
Temp = "{"
If StrComp(TestCheck, Temp, vbTextCompare) = 0 Then
Selection.InsertRowsBelow
Selection.Font.Bold = False
If Not P.Range.ListFormat.List Is Nothing Then
Selection.Tables(1).Rows.Last.Cells(1).Range.Text = P.Range.ListFormat.ListValue
End If
Selection.Tables(1).Rows.Last.Cells(2).Range.Text = Mid$(.Text, 3, Len(.Text) - 3)
Selection.InsertRowsBelow
Selection.Tables(1).Rows.Last.Cells(2).Range.Text = "Record"
Else
Selection.InsertRowsBelow
Selection.Font.Bold = False
If Not P.Range.ListFormat.List Is Nothing Then
Selection.Tables(1).Rows.Last.Cells(1).Range.Text = P.Range.ListFormat.ListValue
End If
Selection.Tables(1).Rows.Last.Cells(2).Range.Text = Mid$(.Text, 2, Len(.Text) - 2)
End If
End If
End With

End If
Next

End Sub

Thanks again for all your help! I wouldn't have been able to get this far without it :bow: