Problem with iterating though pages

[Stephen English]

Hi
I am wanting to iterate through all the pages. For each page I want to
iterate through all the shapes and select most but not all of them. An
earlier question was kindly answered on how to do this.

It works OK for the first page but I am not selecting the second page
correctly
- see ????????I need to select the page here
in code below

and then it is failing when I select the shapes
- see '??????????Next line is failing at the moment when it gets to the
second page

Cheers
Stephen


'Iterate through all open documents.
Set vsoDocuments = Application.Documents
For Each vsoDocument In vsoDocuments
' I only need the document with the pages here not all the behind the scenes
stuff!

'Iterate through all pages in a drawing.
Set vsoPages = ActiveDocument.Pages
For Each vsoPage In vsoPages
' ????????I need to select the page here
ActiveWindow.DeselectAll
Set vsoShapes = vsoPage.Shapes
For i1 = 1 To vsoShapes.Count
'??????????Next line is failing at the moment when it gets
to the second page
ActiveWindow.Select vsoShapes.ItemFromID(i1), visSelect
Next i1
ActiveWindow.Selection.Copy
If fsoSysobj.FileExists(strPath & vsoPage.Name & ".doc") Then
' open it
Set wDoc = wApp.Documents.Open(strPath & vsoPage.Name &
".doc")
wDoc.Select
Selection.Delete
Else
Set wDoc = wApp.Documents.Add '("C:\Program Files\Microsoft
Office\Templates\COS - General\LandscapeBlank.dot")
wDoc.SaveAs (strPath & vsoPage.Name & "1.doc")
Set wDoc =
wApp.Documents.Open("J:\CorpDev\Admin\OrgCharts\Visio\Converted\" &
vsoPage.Name & "1.doc")
With wDoc.PageSetup
.BottomMargin = CentimetersToPoints(1.05)
.TopMargin = CentimetersToPoints(1)
.RightMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2)
.Orientation = wdOrientLandscape
End With
End If
wDoc.Select
Selection.Paste
wDoc.Close Savechanges:=True
Next
Next

 

[JuneTheSecond]

Please add a line
ActiveWindow.Page = vsoPage
before
ActiveWindow.Select vsoShapes.ItemFromID(i1), visSelect