Using Word 2002 and 2003.
Have a routine that loops through an array, builds up a string and then puts
the string in the document.
Occasionally this doesn't work properly and only part of the array appears
in the document.
The problem is that I can't just see any reason why this would be happening.
I have dumped the array to a textfile to have a look at it, but it all looks
normal or in any case no different from
other arrays that appear in the document fine.
The array is an 0-based 2D array with 4 or 5 columns and up to about 100
rows.
It contains dates, numbers and strings.
As I have no idea still what the problem is here I just post the full Sub in
the hope that somebody has some suggestion
as to where the problem could be.
Leaving out the Exit Sub bits doesn't make a difference.
Any assistance greatly appreciated.
Sub ArrayToWordText(ByRef arr As Variant, _
ByVal lStartCol As Long, _
ByVal lEndCol As Long)
'converts a 2-dimensional array to a Word as plain text
'note that the start and end column are always 1-based
'even when the arrray is 0-based
'-----------------------------------------------------
Dim rng As Range
Dim tbl As Table
Dim LB1 As Byte
Dim LB2 As Byte
Dim UB1 As Long
Dim UB2 As Long
Dim lRows As Long
Dim lCols As Long
Dim i As Long
Dim c As Long
Dim LB1corr As Byte
Dim LB2corr As Byte
Dim colCorr As Integer
Dim strTemp As String
LB1 = LBound(arr)
UB1 = UBound(arr)
LB2 = LBound(arr, 2)
UB2 = UBound(arr, 2)
LB1corr = 1 - LB1
'0-based array >> LB2corr will be 1
'1-based array >> LB2corr will be 0
LB2corr = 1 - LB2
colCorr = lStartCol - (LB2corr + 1)
lRows = (UB1 - LB1) + 1
lCols = (lEndCol - lStartCol) + 1
Application.ScreenUpdating = False
Set rng = Selection.Range
rng.Collapse Direction:=wdCollapseEnd
On Error GoTo ERRORADDINGTABLE
'for debugging
'-------------
If bArray2Text = True Then
SaveArrayToText2 "C:\NotesDump.txt", arr
End If
For i = 1 To lRows
If BPArray(i - LB1corr) = 1 Then
'dealing with BP entry
'---------------------
For c = 1 To lCols
If strNoteSubject <> "Q" Then
If arr(1 - LB1corr, 1 + colCorr) = Empty Then
Exit For
End If
End If
Select Case c
Case 1
strTemp = strTemp & arr(i - LB1corr, c + colCorr)
Case lCols
If lCols = 4 Then
If Not arr(i - LB1corr, c + colCorr) = Empty
Then
strTemp = strTemp & "/" & arr(i - LB1corr, c
+ colCorr) & Chr(13)
End If
Else
If arr(i - LB1corr, c + colCorr) = Empty Then
strTemp = strTemp & Chr(13)
Else
strTemp = strTemp & ", " & _
arr(i - LB1corr, c + colCorr) &
Chr(13)
End If
End If
Case Else
If c = 4 Then
If Not arr(i - LB1corr, c + colCorr) = Empty
Then
strTemp = strTemp & "/" & arr(i - LB1corr, c
+ colCorr)
End If
Else
If Not arr(i - LB1corr, c + colCorr) = Empty
Then
strTemp = strTemp & ", " & arr(i - LB1corr,
c + colCorr)
End If
End If
End Select
Next
Else
'not dealing with BP entry
'-------------------------
For c = 1 To lCols
If strNoteSubject <> "Q" Then
If arr(1 - LB1corr, 1 + colCorr) = Empty Then
Exit For
End If
End If
Select Case c
Case 1
strTemp = strTemp & arr(i - LB1corr, c + colCorr)
Case lCols
If TestArray(i - 1) = 1 And c + colCorr = 3 Then
'dealing with test value and unit, so no comma
'---------------------------------------------
strTemp = strTemp & " " & _
arr(i - LB1corr, c + colCorr) &
Chr(13)
Else
If arr(i - LB1corr, c + colCorr) = Empty Or _
arr(i - LB1corr, c + colCorr) = Chr(32) Or _
arr(i - LB1corr, c + colCorr) = vbNull Or _
Trim(arr(i - LB1corr, c + colCorr)) = "" Then
strTemp = strTemp & Chr(13)
Else
strTemp = strTemp & ", " & _
arr(i - LB1corr, c + colCorr) &
Chr(13)
End If
End If
Case Else
If TestArray(i - 1) = 1 And c + colCorr = 3 Then
'dealing with test value and unit, so no comma
'---------------------------------------------
strTemp = strTemp & " " & arr(i - LB1corr, c +
colCorr)
Else
If Not arr(i - LB1corr, c + colCorr) = Empty And
_
Not arr(i - LB1corr, c + colCorr) = Chr(32)
And _
Not arr(i - LB1corr, c + colCorr) = vbNull
And _
Not Trim(arr(i - LB1corr, c + colCorr)) = ""
Then
strTemp = strTemp & ", " & arr(i - LB1corr,
c + colCorr)
End If
End If
End Select
Next
End If
Next
'not sure why this is still needed, should have been filtered out above
'----------------------------------------------------------------------
strTemp = Replace(strTemp, ", " & Chr(13), Chr(13), 1, -1,
vbTextCompare)
strTemp = Replace(strTemp, " <-| ", Chr(13) & Chr(9), 1, -1,
vbTextCompare)
strTemp = Replace(strTemp, " <-|", "", 1, -1, vbTextCompare)
'to indent after linebreak
'-------------------------
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(2.1)
.FirstLineIndent = CentimetersToPoints(-2.1)
End With
With Selection
.TypeText Text:=strTemp
.MoveDown Unit:=wdLine, count:=2
End With
'back to normal linebreak
'------------------------
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.FirstLineIndent = CentimetersToPoints(0)
End With
Application.ScreenUpdating = True
Exit Sub
ERRORADDINGTABLE:
Application.ScreenUpdating = True
MsgBox "COULDN'T PUT THE ARRAY HERE!", vbInformation, ""
On Error GoTo 0
End Sub
RBS