Help debugging code

R

RB Smissaert

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
 
W

Word Heretic

G'day "RB Smissaert" <[email protected]>,

10:1 says you have exceeded 255 characters length in your output
string. Just output the contents sequentially directly into the
document and forget this string intermediatry. If necc, use find and
replace or post process the para you are in.

Steve Hudson - Word Heretic
Want a hyperlinked index? S/W R&D? See WordHeretic.com

steve from wordheretic.com (Email replies require payment)


RB Smissaert reckoned:
 
A

Andi Mayer

If strNoteSubject <> "Q" Then
If arr(1 - LB1corr, 1 + colCorr) = Empty Then
Exit For
End If
End If
Click to expand...

but this is the single source for an early stop, therefore I think
your logic has a fault there.

If you expect an answer to a personal mail, add the word "manfred" to the first 10 lines in the message
MW
 
R

RB Smissaert

Word Heretic,

Thanks, never thought of that.
I think I have done strings longer than that, but will try without the
intermediate string.
What did you mean with 10:1?

RBS
 
R

RB Smissaert

Thanks, but I left that out and it was the same fault.
Perhaps Word Heretic's answer is right.

RBS
 
R

RB Smissaert

I am not sure the string length is the problem. As there is a similar
problem with the following Sub
that puts the array in a table.

Sub ArrayToWordTable(ByRef arr As Variant, _
ByVal lStartCol As Long, _
ByVal lEndCol As Long)

'converts a 2-dimensional array to a Word table
'note that the start and end column are always 1-based
'even when the arrray is 0-based
'note that Word 2000 hasn't got the style property for
'for tables, so this has to be done with Table, properties
'---------------------------------------------------------

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

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

Set tbl = ActiveDocument.Tables.Add(rng, _
lRows, _
lCols)
On Error GoTo 0

For i = 1 To lRows
For c = 1 To lCols
If Not arr(i - LB1corr, c + colCorr) = Empty Then
tbl.Cell(i, c).Range.Text = arr(i - LB1corr, c + colCorr)
End If
Next
Next

For i = 1 To lRows
If i Mod 2 = 0 Then
tbl.Rows(i).Shading.BackgroundPatternColor = wdColorGray05
Else
tbl.Rows(i).Shading.BackgroundPatternColor = wdColorGray15
End If
Next

With tbl
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth225pt
.Color = wdColorWhite
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth225pt
.Color = wdColorWhite
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth225pt
.Color = wdColorWhite
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth225pt
.Color = wdColorWhite
End With
If tbl.Rows.count > 1 Then
With .Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth225pt
.Color = wdColorWhite
End With
End If
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth225pt
.Color = wdColorWhite
End With
.AllowPageBreaks = True
.AllowAutoFit = True
.AutoFitBehavior (wdAutoFitContent)
.Cell(lRows, lCols).Select
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth225pt
.DefaultBorderColor = wdColorWhite
End With

With Selection
.MoveDown Unit:=wdLine
.TypeParagraph
End With

Application.ScreenUpdating = True

Exit Sub
ERRORADDINGTABLE:

Application.ScreenUpdating = True
MsgBox "CAN'T PUT A TABLE HERE !", vbInformation, ""

End Sub


Unfortunately, I can't reproduce this bug at all, despite having tried it on
the same
Word version as the customer (2002).


RBS
 
R

RB Smissaert

Just tried one. No problem at all and the character count was over 5000.
Don't think the string length is the problem.

RBS
 
A

Andi Mayer

Just tried one. No problem at all and the character count was over 5000.
Don't think the string length is the problem.
Click to expand...

check your array for controlcodes?


If you expect an answer to a personal mail, add the word "manfred" to the first 10 lines in the message
MW
 
R

RB Smissaert

I added a function to dump the array to text for debugging purpose.
This text file looked fine even when the write to the document was not fine.

RBS
 
A

Andi Mayer

I added a function to dump the array to text for debugging purpose.
This text file looked fine even when the write to the document was not fine.
Click to expand...

but this doesnt't help if this array has ASCII Values which are not
shown in Notepad and Co.


If you expect an answer to a personal mail, add the word "manfred" to the first 10 lines in the message
MW
 
R

RB Smissaert

That is true.
Any suggestions?

RBS

Andi Mayer said:
but this doesnt't help if this array has ASCII Values which are not
shown in Notepad and Co.


If you expect an answer to a personal mail, add the word "manfred" to the
first 10 lines in the message
MW
Click to expand...
 
A

Andi Mayer

That is true.
Any suggestions?
Click to expand...
try this in as a module
It is an extract from an IBM-Universe to Access conversion-class
in the "makeConvAry" -Sub you decide which Ascii-Value you want
converted, in this example you change also the ["] and the ['] to
blanks, if you make the to "no-take" ([chr(0)] ) then they will
disapear also.

Good luck

Option Compare Database
Option Explicit
Public convAry(255) As String * 1

Public Function StringConv(ByVal theString As String) As String
'deletes all Charakter which are not in convAry
'!Attention: doesn't work with Chr(0), because this is the no-take
Dim tmp As String
Dim I As Long
Dim Nr As Integer
If convAry(65) <> "A" Then makeConvAry
' assume that "A" is not a 'no-take'

For I = 1 To Len(theString)
Nr = Asc(Mid(theString, I, 1))
If convAry(Nr) <> Chr(0) Then tmp = tmp & convAry(Nr)
Next I
StringConv = tmp
End Function

Sub makeConvAry()
Dim I As Integer
For I = 0 To 255 'all to dont'take
convAry(I) = Chr(0)
Next I
For I = 32 To 127 'all alpha numerics and usual thinks
convAry(I) = Chr(I)
Next I

convAry(34) = vbNullString ' das ["] gibt troubles bei allen möglichen
in Access
convAry(39) = vbNullString ' das ['] gibt troubles bei SQL

'this is a spezial Conversion for an Englisch IBM-Universe to German
convAry(214) = Chr(214) 'Ö
convAry(246) = Chr(246) 'ö
convAry(196) = Chr(196) 'Ä
convAry(228) = Chr(228) 'ä
convAry(220) = Chr(220) 'Ü
convAry(252) = Chr(252) 'ü
convAry(223) = Chr(223) 'ß

End Sub

If you expect an answer to a personal mail, add the word "manfred" to the first 10 lines in the message
MW
 
R

RB Smissaert

Thanks, I could try that, but I am not sure it would solve this bug.
When I try all the possible characters like this:

Sub TryAllCharacters()

Dim i As Long

For i = 0 To 255
With Selection
.TypeText Text:=i & ": " & Chr(i)
.TypeParagraph
End With
Next

End Sub

It goes to the document all fine.
Could there be characters outside these 255 (or more precisely 256)
characters?


RBS

Andi Mayer said:
That is true.
Any suggestions?
Click to expand...
try this in as a module
It is an extract from an IBM-Universe to Access conversion-class
in the "makeConvAry" -Sub you decide which Ascii-Value you want
converted, in this example you change also the ["] and the ['] to
blanks, if you make the to "no-take" ([chr(0)] ) then they will
disapear also.

Good luck

Option Compare Database
Option Explicit
Public convAry(255) As String * 1

Public Function StringConv(ByVal theString As String) As String
'deletes all Charakter which are not in convAry
'!Attention: doesn't work with Chr(0), because this is the no-take
Dim tmp As String
Dim I As Long
Dim Nr As Integer
If convAry(65) <> "A" Then makeConvAry
' assume that "A" is not a 'no-take'

For I = 1 To Len(theString)
Nr = Asc(Mid(theString, I, 1))
If convAry(Nr) <> Chr(0) Then tmp = tmp & convAry(Nr)
Next I
StringConv = tmp
End Function

Sub makeConvAry()
Dim I As Integer
For I = 0 To 255 'all to dont'take
convAry(I) = Chr(0)
Next I
For I = 32 To 127 'all alpha numerics and usual thinks
convAry(I) = Chr(I)
Next I

convAry(34) = vbNullString ' das ["] gibt troubles bei allen möglichen
in Access
convAry(39) = vbNullString ' das ['] gibt troubles bei SQL

'this is a spezial Conversion for an Englisch IBM-Universe to German
convAry(214) = Chr(214) 'Ö
convAry(246) = Chr(246) 'ö
convAry(196) = Chr(196) 'Ä
convAry(228) = Chr(228) 'ä
convAry(220) = Chr(220) 'Ü
convAry(252) = Chr(252) 'ü
convAry(223) = Chr(223) 'ß

End Sub

If you expect an answer to a personal mail, add the word "manfred" to the
first 10 lines in the message
MW
Click to expand...
 
A

Andi Mayer

Thanks, I could try that, but I am not sure it would solve this bug.
When I try all the possible characters like this:

.TypeText Text:=i & ": " & Chr(i)
.TypeParagraph
Click to expand...
this shows the Text, but not if you have inserted some codes.

the selection.text shows text and nothing else

If you expect an answer to a personal mail, add the word "manfred" to the first 10 lines in the message
MW
 
R

RB Smissaert

the selection.text shows text and nothing else

Yes, but that doesn't explain why the string gets broken off. There are many
ordinary printable characters after
the point where it stops. It would explain it if there were just gaps.
The customer is going to have a direct look in the database with IB_SQL,
hopefully that will give some insight.

RBS
 
W

Word Heretic

G'day "RB Smissaert" <[email protected]>,

10:1 is a reference to a horse racing bet, or any other form of wager.
If you want to bet on you having exceeded it, then a $10 wager will
give you $1 win, with the trivial obverse also being true.

In other words, it was a pretty sure bet. I wonder if Aussies only
like sport because they can bet on it... nah, low %'s do :)

Steve Hudson - Word Heretic
Want a hyperlinked index? S/W R&D? See WordHeretic.com

steve from wordheretic.com (Email replies require payment)


RB Smissaert reckoned:
 
W

Word Heretic

G'day "RB Smissaert" <[email protected]>,

Ack. Look, let's go back to square one here. Word can easily return a
string exceeding 255 chars length. If you try and use any VBA string
functions upon it it terminates at 255. If you try and build a string
from VBA, its 255.

I'm afraid I will have to fall back to the std support line here:
please reduce this mess to six lines of code that demonstrates the
problem if you want me tackle it line by line.


Steve Hudson - Word Heretic
Want a hyperlinked index? S/W R&D? See WordHeretic.com

steve from wordheretic.com (Email replies require payment)


RB Smissaert reckoned:
 
R

RB Smissaert

If you try and use any VBA string functions upon it it terminates at 255.
If you try and build a string from VBA, its 255
Click to expand...

If this is true then why doesn't this bug show with me? I run the same
string functions
and with me always the whole string shows, even when there are way more than
255
characters. Even with the customers, most of the time all of the string will
show, even when
there are way more than 255 characters.

I wish I could condense the problem in a few lines. The problem is that this
bug is
just very difficult to reproduce. I can't reproduce it all and the customer
gets varying
results on this particular record, meaning the string gets cut off at
varying points.

Will see what I can do.
Thanks anyhow for the interest.


RBS
 
R

RB Smissaert

If it is of any help the following Sub will give a similar problem with
those particular records.
It does the same thing as the other Sub, except it will put the array in a
Word table.
The bug will manifest itself differently as there is no long string to write
to Word. Word will just freeze up.
I have left non-essential bits out.

Sub ArrayToWordTable(ByRef arr As Variant, _
ByVal lStartCol As Long, _
ByVal lEndCol As Long)

'converts a 2-dimensional array to a Word table
'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

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

Set tbl = ActiveDocument.Tables.Add(rng, _
lRows, _
lCols)
On Error GoTo 0

For i = 1 To lRows
For c = 1 To lCols
If Not arr(i - LB1corr, c + colCorr) = Empty Then
tbl.Cell(i, c).Range.Text = arr(i - LB1corr, c + colCorr)
End If
Next
Next

Application.ScreenUpdating = True

Exit Sub
ERRORADDINGTABLE:

Application.ScreenUpdating = True
MsgBox "CAN'T PUT A TABLE HERE !", vbInformation, ""

End Sub


Your advice is greatly appreciated.


RBS
 
W

Word Heretic

G'day "RB Smissaert" <[email protected]>,

What is Empty?

The fast way is

If Len(SomeString)=0 then

Steve Hudson - Word Heretic
Want a hyperlinked index? S/W R&D? See WordHeretic.com

steve from wordheretic.com (Email replies require payment)


RB Smissaert reckoned:
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA-Table Word 2019 - Move a selected text, from a cell to the adjacent cell to its right, by pressing the ENTER key 0
Working outlook via vba code with xlsx - error 0
Baffled with assignment of range to array why won't it work??? Anyhelp appreciated 4
Keep First Letters, with exceptions 0
Word macro that can call cells out of Excel for a find and replace 0
export vba not working 0
VBA Coding Help for Beginner 0
CheckIBAN 5

Top