I wonder if this might be useful. It was very useful for me at the time.... I wrote it some time ago :-)
I have an excel version too to dump to a worksheet.
Sub subDumpString(strpLine As String, _
Optional vpLineNum As Variant)
' Dump a string.
Dim intlI As Integer
Dim strlLine As String
Dim intlICols As Integer
Dim intlRows As Integer
Dim objlRange As Object
Dim intlCol As Integer
Dim intlTableNum As Integer
Dim intlRemainder As Integer
Dim intlColsDone As Integer
Dim strlLineNum As String
Dim slChr As String * 1
If IsMissing(vpLineNum) Then
strlLineNum = "No Line number given"
Else
strlLineNum = "Line " & Str$(vpLineNum)
End If
intlTableNum = 0
strlLine = strpLine
Documents.Add
Set objlRange = ActiveDocument.Content
With objlRange
Selection.InsertAfter "Line >" & strlLine & "<" & vbCrLf & vbCrLf
Selection.InsertAfter "Length =" & Len(strlLine) & vbCrLf & vbCrLf
Selection.InsertAfter strlLineNum & vbCrLf & vbCrLf
intlI = 1
intlRows = 1
intlCol = 12
Do
If intlCol > 11 Then
Selection.EndKey Unit:=wdStory
Selection.InsertAfter intlI & " To " & intlI + 9 & vbCrLf
Selection.EndKey Unit:=wdStory
ActiveDocument.Tables.Add _
Range:=Selection.Range, _
NumRows:=3, _
NumColumns:=11, _
DefaultTableBehavior:=wdWord9TableBehavior, _
AutoFitBehavior:=wdAutoFitFixed
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.TypeParagraph
intlCol = 2
intlTableNum = intlTableNum + 1
ActiveDocument.Tables(intlTableNum) _
.Cell(1, 1).Range.Text _
= "Chr"
ActiveDocument.Tables(intlTableNum) _
.Cell(2, 1).Range.Text _
= "Asc"
ActiveDocument.Tables(intlTableNum) _
.Cell(3, 1).Range.Text _
= "Chr #"
End If
slChr = Mid$(strlLine, intlI, 1)
ActiveDocument.Tables(intlTableNum) _
.Cell(1, intlCol).Range.Text _
= slChr
ActiveDocument.Tables(intlTableNum) _
.Cell(2, intlCol).Range.Text _
= Asc(slChr)
ActiveDocument.Tables(intlTableNum) _
.Cell(3, intlCol).Range.Text _
= intlI
Selection.Collapse wdCollapseEnd
intlCol = intlCol + 1
intlI = intlI + 1
Loop Until intlI > Len(strlLine)
End With
Set objlRange = Nothing
' ***********************************************************************
End Sub
Tidak ada komentar:
Posting Komentar