get-a-clue.bas

REM  *****  BASIC  *****
'
' Get-a-Clue : OTR Global Grid parser
' (c) 2008 Paul Philippov, themactep.com
' version 2008-10-20 13:59
'
Option Explicit

Sub ExportQuotesToNewDocument
  Dim OpenProperties(1) as New com.sun.star.beans.PropertyValue
  Dim i, iCol, iRow as Integer
  Dim oFileDialog, oUcb, oDocumentGrid, oDocumentReport, oSheet, oCell, oTextCursor as Object
  Dim sPath, sText, sSourceName as String
  Dim StopWords(15)
  Dim ListAny(0)

  StopWords(0) = ""
  StopWords(1) = "Why"
  StopWords(2) = "Drop Down"
  StopWords(3) = "na"
  StopWords(4) = "nr"
  StopWords(5) = "Don't know"
  StopWords(6) = "Above"
  StopWords(7) = "Below"
  StopWords(8) = "Not applicable"
  StopWords(9) = "No response"
  StopWords(10) = "Improved"
  StopWords(11) = "Deteriorated"
  StopWords(12) = "In line"
  StopWords(13) = "up"
  StopWords(14) = "down"
  StopWords(15) = "same"

  For i=LBound(StopWords) To UBound(StopWords)-1
    StopWords(i) = LCase(StopWords(i))
  Next i

  BasicLibraries.LoadLibrary("Tools")
  
  oDocumentGrid = StarDesktop.ActiveFrame.Controller.Model
  If GetDocumentType(oDocumentGrid) <> "scalc" Then
    ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
    oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
    oFileDialog.initialize(ListAny())
    If oFileDialog.Execute() <> 1 Then
      Msgbox("No file selected, macro aborted!", 24, GetProductName())
      Exit Sub
    End If
    sPath = oFileDialog.Files(0)
    oFileDialog.Dispose()

    oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
    If Not oUcb.Exists(sPath) Then
      Msgbox("Can not find file, macro aborted!", 24, GetProductName())
      Exit Sub
    End If
    oDocumentGrid = OpenDocument(sPath, OpenProperties())  
  End If
  If GetDocumentType(oDocumentGrid) <> "scalc" Then
    Msgbox("Invalid file format, macro aborted!", 24, GetProductName())
    Exit Sub
  End If
  oSheet = oDocumentGrid.Sheets(0)

  oDocumentReport = CreateNewDocument("swriter")
  If IsNull(oDocumentReport) Then
    print "Can't create Text Document"
    Exit Sub
  End If

  oTextCursor = oDocumentReport.Text.CreateTextCursor()
  oTextCursor.ParaKeepTogether = False
  oTextCursor.charFontName = "Arial"

  For iCol = 4 To 77
    For iRow = 2 To 40
      oCell = oSheet.GetCellByPosition(iCol, iRow)
      sText = oCell.String
      sSourceName = oSheet.GetCellByPosition(1, iRow).String
      
      If Left(sText, 6) = "Choice" Then
        Exit For
      End If
      
      If iRow < 3 or "Source" <> Left(sSourceName,6) Then
        If oCell.Type <> 1 And Not FieldInList(sText, StopWords) Then
          If 2 = iRow Then: oTextCursor.CharHeight = 18: End if
          If 3 = iRow Then: oTextCursor.CharHeight = 14: End If
          If 3 < iRow Then: oTextCursor.CharHeight = 11: End If
          oDocumentReport.Text.insertControlCharacter(oTextCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
          oDocumentReport.Text.insertString(oTextCursor, sText, False)
          If 3 < iRow Then
            oTextCursor.CharHeight = 9
	    oDocumentReport.Text.insertControlCharacter(oTextCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
            oDocumentReport.Text.insertString(oTextCursor, sSourceName, False)
          End If
          oDocumentReport.Text.insertControlCharacter(oTextCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
        End If
      End If
    Next iRow
    if sText = "ADDITIONAL INFORMATION" Then
      Exit Sub
    End If
  Next iCol
  Msgbox("Export successfully completed!", 48, GetProductName())
End Sub

gistfile2.txt