Adamski
05-06-2010, 03:27 AM
I have been using Word 2003 automation to export data from a database. I noticed that sporadically a paragraph would not have the correct formatting. On investigation I ruled out errors in my automation script and ran a test directly in Word VBA.
The paragraph formatting issue occured.
Can anyone see the problem with this sub? I think it is some Word bug, but the style fails at different paragraphs on subsequent execution. I guessed it was due to memory but strangely, it failed at the same paragraps, in the same order on two machines with completely different memory.
Is there a solution?
Sub StyleChangeTest()
Dim StyleToUse As String
Dim StyleUsed As String
Dim Count As Integer
Count = 0
Dim Run As Boolean
Run = True
Dim InsertRange As Range
Set InsertRange = Application.ActiveDocument.Range
While (Run And Count < 1000)
Count = Count + 1
StyleToUse = "Heading 1"
InsertRange.Style = StyleToUse
InsertRange.Text = StyleToUse & " : " & Count
InsertRange.Collapse (wdCollapseEnd)
StyleUsed = InsertRange.Style
InsertRange.InsertParagraph
InsertRange.Collapse (wdCollapseEnd)
If StyleUsed <> StyleToUse Then
Run = False
Debug.Print Count & ", Use: " & StyleToUse & " , Used: " & StyleUsed
End If
Count = Count + 1
StyleToUse = "Heading 2"
InsertRange.Style = StyleToUse
InsertRange.Text = StyleToUse & " : " & Count
InsertRange.Collapse (wdCollapseEnd)
StyleUsed = InsertRange.Style
InsertRange.InsertParagraph
InsertRange.Collapse (wdCollapseEnd)
If StyleUsed <> StyleToUse Then
Run = False
Debug.Print Count & ", Use: " & StyleToUse & " , Used: " & StyleUsed
End If
Count = Count + 1
StyleToUse = "Heading 3"
InsertRange.Style = StyleToUse
InsertRange.Text = StyleToUse & " : " & Count
InsertRange.Collapse (wdCollapseEnd)
StyleUsed = InsertRange.Style
InsertRange.InsertParagraph
InsertRange.Collapse (wdCollapseEnd)
If StyleUsed <> StyleToUse Then
Run = False
Debug.Print Count & ", Use: " & StyleToUse & " , Used: " & StyleUsed
End If
Count = Count + 1
StyleToUse = "Normal"
InsertRange.Style = StyleToUse
InsertRange.Text = StyleToUse & " : " & Count
InsertRange.Collapse (wdCollapseEnd)
StyleUsed = InsertRange.Style
InsertRange.InsertParagraph
InsertRange.Collapse (wdCollapseEnd)
If StyleUsed <> StyleToUse Then
Run = False
Debug.Print Count & ", Use: " & StyleToUse & " , Used: " & StyleUsed
End If
InsertRange.Document.UndoClear
Wend
If Run Then
Debug.Print "Reached Iteration Limit"
End If
End Sub
The paragraph formatting issue occured.
Can anyone see the problem with this sub? I think it is some Word bug, but the style fails at different paragraphs on subsequent execution. I guessed it was due to memory but strangely, it failed at the same paragraps, in the same order on two machines with completely different memory.
Is there a solution?
Sub StyleChangeTest()
Dim StyleToUse As String
Dim StyleUsed As String
Dim Count As Integer
Count = 0
Dim Run As Boolean
Run = True
Dim InsertRange As Range
Set InsertRange = Application.ActiveDocument.Range
While (Run And Count < 1000)
Count = Count + 1
StyleToUse = "Heading 1"
InsertRange.Style = StyleToUse
InsertRange.Text = StyleToUse & " : " & Count
InsertRange.Collapse (wdCollapseEnd)
StyleUsed = InsertRange.Style
InsertRange.InsertParagraph
InsertRange.Collapse (wdCollapseEnd)
If StyleUsed <> StyleToUse Then
Run = False
Debug.Print Count & ", Use: " & StyleToUse & " , Used: " & StyleUsed
End If
Count = Count + 1
StyleToUse = "Heading 2"
InsertRange.Style = StyleToUse
InsertRange.Text = StyleToUse & " : " & Count
InsertRange.Collapse (wdCollapseEnd)
StyleUsed = InsertRange.Style
InsertRange.InsertParagraph
InsertRange.Collapse (wdCollapseEnd)
If StyleUsed <> StyleToUse Then
Run = False
Debug.Print Count & ", Use: " & StyleToUse & " , Used: " & StyleUsed
End If
Count = Count + 1
StyleToUse = "Heading 3"
InsertRange.Style = StyleToUse
InsertRange.Text = StyleToUse & " : " & Count
InsertRange.Collapse (wdCollapseEnd)
StyleUsed = InsertRange.Style
InsertRange.InsertParagraph
InsertRange.Collapse (wdCollapseEnd)
If StyleUsed <> StyleToUse Then
Run = False
Debug.Print Count & ", Use: " & StyleToUse & " , Used: " & StyleUsed
End If
Count = Count + 1
StyleToUse = "Normal"
InsertRange.Style = StyleToUse
InsertRange.Text = StyleToUse & " : " & Count
InsertRange.Collapse (wdCollapseEnd)
StyleUsed = InsertRange.Style
InsertRange.InsertParagraph
InsertRange.Collapse (wdCollapseEnd)
If StyleUsed <> StyleToUse Then
Run = False
Debug.Print Count & ", Use: " & StyleToUse & " , Used: " & StyleUsed
End If
InsertRange.Document.UndoClear
Wend
If Run Then
Debug.Print "Reached Iteration Limit"
End If
End Sub