Gordon,
We all have Woord 2003 on our computors. What do you mean by checking for
broken references in the VBA projects that might indicate a difference
between systems that wouldn't be visible otherwise?
They do run through to the end but I don't get the expected
results on the other computor? On my computors they give me the expected
results.
Here is the part of a macro that works on my machines and not on the other
persons machine. It gets the info but when it loads it into the bookmarks is
where it breaks down. Its hard to troubleshoot because I don't have a problem
with my computor and I can't sit at the other computor all day trying
tofigure whats wrong with their machine.
Dim strWord1 As String
Dim strWord2 As String
Dim strWord3 As String
Dim strWord4 As String
Dim strWord5 As String
Dim strWord6 As String
Dim oBkRange As Range
Dim strBk1 As String
Dim strBk2 As String
Dim strBk3 As String
Dim strBk4 As String
Dim strBk5 As String
Dim strBk6 As String
Dim strBk7 As String
Dim strBk8 As String
Dim strBk9 As String
Dim strBk10 As String
Dim strBk12 As String
Dim strBk11 As String
'Define bookmark names
strBk1 = "bknbr"
strBk2 = "bknbr1"
strBk3 = "bknbr2"
strBk10 = "bknbr3"
strBk4 = "bkRevision"
strBk5 = "bktitle"
strBk6 = "bkRev"
strBk7 = "bktitle1"
strBk8 = "bkuse"
strBk9 = "bkuse1"
strBk12 = "bkProTitle"
strBk11 = "bkDate"
On Error GoTo endthis
With ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Tables(1)
strWord2 = .Cell(1, 2).Range.Text
strWord2 = Mid(strWord2, 12, Len(strWord2) - 13) '3
End With
With ActiveDocument.Tables(1)
strWord1 = .Cell(3, 1).Range.Text
strWord1 = Mid(strWord1, 11, Len(strWord1) - 12) '2
'Trim removes trailing spaces
strWord3 = .Cell(6, 1).Range.Text
strWord3 = Mid(strWord3, 9, Len(strWord3) - 10)
'Trim removes trailing spaces
strWord4 = .Cell(1, 2).Range.Text
strWord4 = Mid(strWord4, 2, Len(strWord4) - 8)
'Trim removes trailing spaces
strWord5 = .Cell(2, 1).Range.Text
strWord5 = Mid(strWord5, 2, Len(strWord5) - 3)
'Trim removes trailing spaces
strWord6 = .Cell(3, 3).Range.Text
strWord6 = Mid(strWord6, 9, Len(strWord6) - 10)
End With
endthis:
Dim objSection As Section
Dim objRange As Range
Dim objHeaderFooter As HeaderFooter
' Delete all footers from each section
For Each objSection In ActiveDocument.Sections
For Each objHeaderFooter In objSection.Footers
objHeaderFooter.Range.Delete
Next objHeaderFooter
Next objSection
Selection.HomeKey wdStory
' Create a range for the start of the document
Selection.Bookmarks("\Page").Range.Delete
'Documents.Open FileName:="""\\domain1\groups\Administrative
Services\Documents Ready to Process\Procedure Master Templates\Pro Master
Pg1.doc""", _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""
Selection.WholeStory
Selection.Copy
ActiveDocument.Close
Selection.PasteAndFormat (wdPasteDefault)
ActiveWindow.ActivePane.VerticalPercentScrolled = 7
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Set objSection = Nothing
Set objRange = Nothing
Set objHeaderFooter = Nothing
Selection.MoveDown Unit:=wdScreen, Count:=3
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.LinkToPrevious = Not Selection.HeaderFooter. _
LinkToPrevious
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.HomeKey wdStory
'Update bookmark text
'Bookmarks must be added again
With ActiveDocument
'Update first bookmark
Set oBkRange = .Bookmarks(strBk1).Range
oBkRange.Text = strWord1
'Add bookmark again
.Bookmarks.Add Name:=strBk1, Range:=oBkRange
Set oBkRange = .Bookmarks(strBk2).Range
oBkRange.Text = strWord1
'Add bookmark again
.Bookmarks.Add Name:=strBk2, Range:=oBkRange
Set oBkRange = .Bookmarks(strBk3).Range
oBkRange.Text = strWord1
'Add bookmark again
.Bookmarks.Add Name:=strBk3, Range:=oBkRange
Set oBkRange = .Bookmarks(strBk10).Range
oBkRange.Text = strWord1
'Add bookmark again
.Bookmarks.Add Name:=strBk10, Range:=oBkRange
'Update second bookmark
Set oBkRange = .Bookmarks(strBk4).Range
oBkRange.Text = strWord2
'Add bookmark again
.Bookmarks.Add Name:=strBk4, Range:=oBkRange
'Update second bookmark
Set oBkRange = .Bookmarks(strBk6).Range
oBkRange.Text = strWord2
'Add bookmark again
.Bookmarks.Add Name:=strBk6, Range:=oBkRange
'Update second bookmark
Set oBkRange = .Bookmarks(strBk5).Range
oBkRange.Text = strWord3
'Add bookmark again
.Bookmarks.Add Name:=strBk5, Range:=oBkRange
'Update second bookmark
Set oBkRange = .Bookmarks(strBk7).Range
oBkRange.Text = strWord3
'Add bookmark again
.Bookmarks.Add Name:=strBk7, Range:=oBkRange
'Update second bookmark
Set oBkRange = .Bookmarks(strBk8).Range
oBkRange.Text = strWord4
'Add bookmark again
.Bookmarks.Add Name:=strBk8, Range:=oBkRange
'Update second bookmark
Set oBkRange = .Bookmarks(strBk9).Range
oBkRange.Text = strWord4
'Add bookmark again
.Bookmarks.Add Name:=strBk9, Range:=oBkRange
'Update second bookmark
Set oBkRange = .Bookmarks(strBk12).Range
oBkRange.Text = strWord5
'Add bookmark again
.Bookmarks.Add Name:=strBk12, Range:=oBkRange
'Update second bookmark
Set oBkRange = .Bookmarks(strBk11).Range
oBkRange.Text = strWord6
'Add bookmark again
.Bookmarks.Add Name:=strBk11, Range:=oBkRange
End With
LEU