PC World Komputer 1997 November/Pcwk1197.iso/LOTUS/Eng-ins/ACROREAD/SUITE/DW09_S6.LSS

Text File | 1996-07-28 | 6KB | 154 lines

Option Public
' Convert text on a page into a table.
' This script consists of two subs: Main and TableInsert.
' Main finds the first non-empty text block on
' the page and converts it into a table. Because
' the sub is called Main, it can be run from
' an icon as well as by choosing Edit - Script - Run.
' Alternatively, you could attach the sub to an event,
' such as the Click event of a placement block.
' The sub Main calls another sub, TableInsert, to do
' some work for it. The code for TableInsert follows
' this sub.
' Declare global constants.
' This constant limits the size of the table. The limit
' depends on your needs.

Const MAX_TABLE_SIZE = 20


Sub Main
' Declare variables.
    Dim CurrentRow As Integer
    Dim CurrentCol As Integer
    Dim MyText As String
    Dim MyCellText As String
    Dim MyTable As Table
    Dim MyTextB As TextBlock
    Dim MyBlockId As Integer
' Check if there is one text block that is not empty
' on the page. Do this by looping through all
' objects on the page and stopping when you find
' a text block that has something in it.
    Forall MyOb In CurrentPage.Objects
   ' If you find a filled in text block,
   ' set MyTextB equal to it and exit the
   ' ForAll statement.

        If (MyOb.IsText And Len(MyOb.TextBlock.Text) > 0) Then
            Set MyTextB = MyOb
            Exit Forall
        End If
    End Forall
' If you have found nothing, then
' put up a message box letting the user know
' there is nothing valid on the page and exit the sub.
' Note, NOTHING is a LotusScript predefined constant; it
' is the initial value of an object variable.
    If (MyTextB Is Nothing) Then
        Messagebox "There are no good text blocks on the page."
        Exit Sub
    End If
' Initialize the variable MyText to the text
' contained in the text block MyTextB.
    MyText = MyTextB.Text
' Create the table and fill it with the data.
' Initalize variables.
    CurrentRow = 1
    CurrentCol = 1
' Create the table, setting the rows and columns equal
' to one. Also, select the type of table.
    Set MyTable = _
    CurrentPage.CreateTable(1,CurrentRow,CurrentCol)
' Figure out how many rows and columns you need.
' Do this by counting newlines.
' Parce the text string, MyText, using the length
' of the text string as the limit of the For loop, and
' going through each character until a carrage return
' or a tab is encountered.  When one of these
' characters is encountered, call the
' sub TableInsert to put the characters found
' up to that point into a table cell. If necessary,
' the sub TableInsert also expands the table.
    For i = 1 To Len(MyText)
        CurrentChar = Mid$(MyText,i,1)

   ' Is the current character a carriage return?
   ' If it is a carriage return, insert text, then
   ' go to next row.
        If (CurrentChar = Chr$(13)) Then
      ' You call the sub TableInsert with the arguments
      ' it requires.  Note, Trim$ removes the leading and
      ' trailing spaces from a text string (in this case,
      ' the text contained in the string MyCellText).
            Call TableInsert(MyTable, _
            Trim$(MyCellText),CurrentRow,CurrentCol)
            CurrentCol = 1
      ' Increment row number; that is, go down to the
      ' next row.
            CurrentRow = CurrentRow + 1
      ' Reinitialize the text string variable MyCellText
      ' to the empty string.
            MyCellText = ""
   ' Is it a tab?  If so, follow same steps
   ' as above, but, after inserting text,
   ' instead of moving down, stay in the same row
   ' and move to the next column.
            Elseif (CurrentChar = Chr$(9)) _
        Then
            Call TableInsert(MyTable,_
            Trim$(MyCellText),CurrentRow,CurrentCol)
      ' Increment column number, that
      ' is, move to next column.
            CurrentCol = CurrentCol + 1
            MyCellText = ""
   ' If neither, then keep on assembling string.
   ' Also, make sure the character isn't a standard
   ' newline (\n, or Ascii 10).
        Elseif (CurrentChar <> Chr$(10)) Then
    ' Assemble string by adding valid characters.
            MyCellText = MyCellText + CurrentChar
        End If
    Next i
' Don't forget to fill the very last cell in the table.
    If (Len(Trim$(MyCellText)) > 0) Then
        Call TableInsert(MyTable, _
        Trim$(MyCellText),CurrentRow,CurrentCol)
    End If
' Finally, delete the text block you found at the
' beginning of this script and put the table into
' the placement block that originally held the text block.
    MyBlockID = MyTextB.PlacementBlock.Id
    MyTextB.Remove
    MyTable.PlacementBlock.PutIntoPlacementBlock(MyBlockId)

End Sub
' This sub, TableInsert, works with the above sub, Main.
' The job of TableInsert is to insert text into a table
' cell and, if it is necessary, to expand the number of
' rows and columns in the table.
' The table that was created in Main is passed to it, as is
' the text string and the projected number of rows and
' columns in the table.  When the projected number of rows
' and columns in the table is more than the actual number,
' this sub adds a row or a column to the table.
Sub TableInsert(ATable As Table, SomeText As String, _
RowNum As Integer, ColNum As Integer)
' Declare variable.
    Dim MyTableCell As TextBlock
' Check to see if you were passed a NOTHING reference.
    If (ATable Is Nothing) Then
        Exit Sub
    End If
' Expand the table if necessary - both cols and rows.
    While(ATable.RowCount < RowNum)
        ATable.InsertRow(ATable.RowCount + 1)
    Wend
    While(ATable.ColCount < ColNum)
        ATable.InsertCol(ATable.ColCount + 1)
    Wend
' Now, insert the text into the table cell.
    Set MyTableCell = ATable.GetCell(RowNum,ColNum)
    MyTableCell.Text = SomeText
End Sub