REM  *****  BASIC  *****D:\APPS\ZRP\BASE\macroOOfill.bas
'-----------------------------------------------
Function fillTable(Optional args) As String
  Dim inFile As String
  Dim oBook
  Dim nFileNum As Integer
  Dim j As Integer, n As Integer, k As Integer, kf As Integer
  Dim a() As String, aD(4) As String, aF(7, 9) As String
  Dim cStroka As String
  Dim lFmt As Boolean, lWrap As Boolean, lFrm As Boolean, lCalc As Boolean
  Dim oSh, oCell, oRn, x, y
  Dim fileAccessService  ', textInputStream, inputStream
  Dim oFormats, oLocale, stLine, oBorder
  '
  ' отлавливаем ошибки
  '
  On Error GoTo ErrorHandler

  fillTable = ""
  
  If IsMissing(args) Then
    Exit Function
  Else
    If IsArray(args) Then
      inFile = args(0)
    Else
      inFile = args  
    End If
  End If
  oBook = ThisComponent
  oFormats = oBook.getNumberFormats()
  oLocale = CreateUnoStruct( "com.sun.star.lang.Locale" )
  With oLocale
    .Language = "%Locale.Language%"  ' "ru" или "en"
    .Country  = "%Locale.Country%"   ' "RU" или "US"
  End With
  stLine = CreateUnoStruct("com.sun.star.table.BorderLine")
  stLine.Color = RGB(0, 0, 0)
  stLine.lineDistance = 0
  stLine.innerLineWidth = 0
  stLine.outerLineWidth = 1

  lCalc = oBook.isAutomaticCalculationEnabled()
  If lCalc Then
    oBook.enableAutomaticCalculation(False)
  End If
  lFmt = False
  lFrm = False
  lWrap = False
  i = 0
  k = 0
  kf = 0
  cStroka = ""
  fileAccessService = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  If fileAccessService.exists( inFile ) Then
    cStroka = ""
    nFileNum = FreeFile
    Open inFile For Input As nFileNum
    Do While Not EOF(nFileNum)
      Line Input #nFileNum, cStroka
      If Not (Trim(cStroka) = "") Then
        a = Split(cStroka & String(7,"^"), "^")
        If UCase(a(0)) = "F" Then
          n = UBound(aF, 2)
          If kf > n Then
            n = n + 10
            ReDim Preserve aF(7, n)
          End If   
          aF(0, kf) = a(1) ' номер формата
          aF(1, kf) = a(2) ' формат (v - числовой, t - текстовый, f - формула)
          aF(2, kf) = a(3) ' wrap (w - yes, u - no, empty - no change)
          aF(3, kf) = a(4) ' выравнивание по горизонтали (c - center, l - left, r - right)
          aF(4, kf) = a(5) ' выравнивание по вертикали (c - center, t - top, b - bottom)
          aF(5, kf) = a(6) ' обрамление (tNN;rNN;bNN;lNN или aNN)
          aF(6, kf) = a(7) ' font name
          aF(7, kf) = a(8) ' font size 
          kf = kf + 1
        End If
      End If    
    Loop
    If kf > 0 Then
      kf = kf - 1
      ReDim Preserve aF(7, kf)
      lFmt = True
    End If
    '
    ' загружаем из файла данные
    '
    Seek #nFileNum, 1
    On Error Resume Next
    cStroka = ""
    Do While Not EOF(nFileNum)
      Line Input #nFileNum, cStroka
      If Err <> 0 Then
        GoTo OpNext
      End If
      If Not (Trim(cStroka) = "") Then
        a = Split(cStroka & String(7,"^"), "^")
        If UCase(a(0)) = "D" Then
          aD(0) = a(1) ' номер листа
          aD(1) = a(2) ' номер строки
          aD(2) = a(3) ' номер или буква колонки
          aD(3) = a(4) ' значение
          aD(4) = a(5) ' номер формата
  '
  ' заполнение документа
  '
  '------------------------------------------------
        cStroka=""
        oSh = oBook.getSheets().getByName(aD(0))
        oCell = Nothing
        oRn = Nothing
        oBorder = Nothing
        If Err <> 0 Then
          Resume OpNext
        End If
        j = InStr(1, aD(2), ":")
        If j > 0 Then
          x = Trim(Left(aD(2), j - 1))
          y = Trim(Mid(aD(2), j + 1))
          If IsNumeric(x) Then
'            msgbox("RangeByPosition:N "+x+","+aD(1)+","+y+","+aD(1))
            oRn = oSh.getCellRangeByPosition(val(x) - 1, val(aD(1)) - 1, val(y) - 1, val(aD(1)) - 1)
            oCell = oSh.getCellByPosition(val(x) - 1, val(aD(1)) - 1)
          Else
'            msgbox("RangeByName:C "+x+aD(1)+":"+y+aD(1))
            oRn = oSh.getCellRangeByName(x+aD(1)+":"+y+aD(1))
            oCell = oSh.getCellRangeByName(x+aD(1))
          End If
          If Err <> 0 Then
            Resume OpNext
          End If
          oRn.Merge(True)
        Else
          If IsNumeric(aD(2)) Then
'            msgbox("CellPosition")
            oCell = oSh.getCellByPosition(val(aD(2)) - 1, val(aD(1)) - 1)
          Else
'            msgbox("CellRange "+aD(2)+aD(1))
            oCell = oSh.getCellRangeByName(aD(2)+aD(1))
          End If
          If Err <> 0 Then
            Resume OpNext
          End If
        End If
        If NOT (oCell is Nothing) Then
          ' задан ли формат ?
          If aD(4)="" Then
            ' формат не задан
            Select Case oCell.Type
            Case com.sun.star.table.CellContentType.VALUE
              oCell.setValue(aD(3))
            Case com.sun.star.table.CellContentType.TEXT
              oCell.setString(aD(3))
            Case com.sun.star.table.CellContentType.FORMULA
              oCell.setFormula(aD(3))
              lFrm = True
            Case com.sun.star.table.CellContentType.EMPTY
              oCell.setString(aD(3))
          End Select
        Else
          ' формат задан
          ' есть ли список форматов ?
          If lFmt Then
            ' есть список форматов
            kf = -1
            For j = LBound(aF, 2) To UBound(aF, 2)
              If aF(0, j)=aD(4) Then
                kf = j
                Exit For
              End If
            Next
            '  есть такой формат
            If kf >=0 Then
              ' Тип
              Select Case ucase(aF(1, j))
              Case "F"
                oCell.setFormula(aD(3))
                oCell.setString(aD(3))
                lFrm = True
              Case "V"
                oCell.setValue(aD(3))
                oCell.NumberFormat=oFormats.queryKey("0,00", oLocale, True)
              Case "T"
                oCell.setString(aD(3))
                oCell.NumberFormat=com.sun.star.util.NumberFormat.TEXT
              Case Else
                oCell.setString(aD(3))
                oCell.NumberFormat=com.sun.star.util.NumberFormat.TEXT
              End Select

              ' wrap
              Select Case ucase(aF(2, kf))
              Case "W"
                oCell.isTextWrapped = True
                If NOT (oRn is Nothing) Then
                  oRn.isTextWrapped = True
                End If
                lWrap = True
              Case "U"
                oCell.isTextWrapped = False
                If NOT (oRn is Nothing) Then
                  oRn.isTextWrapped = False
                End If
              End Select

              ' горизонтальное выравнивание
              Select Case ucase(aF(3, kf))
              Case "C"
                oCell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
              Case "L"
                oCell.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT
              Case "R"
                oCell.HoriJustify = com.sun.star.table.CellHoriJustify.RIGHT
              End Select

              ' вертикальное выравнивание
              Select Case ucase(aF(4, kf))
              Case "C"
                oCell.VertJustify = com.sun.star.table.CellVertJustify.CENTER
              Case "T"
                oCell.VertJustify = com.sun.star.table.CellVertJustify.TOP
              Case "B"
                oCell.VertJustify = com.sun.star.table.CellVertJustify.BOTTOM
              End Select

              ' обрамление
              If aF(5, kf) <> "" Then
'                msgbox("border "+aF(5, kf))
                If (oRn is Nothing) Then
                  oBorder = oCell.TableBorder
                Else
                  oBorder = oRn.TableBorder
                End If     
                j = InStr(1, aF(5, kf), ";")
                If j > 0 Then
                  x = Trim(Mid(aF(5, kf), j + 1))
                  n = Val(Trim(Left(aF(5, kf), j - 1)))
                  If n > 0 Then
                    If n <= 25 Then
                      n = 10
                    ElseIf n <= 50 Then
                      n = 25
                    ElseIf n <= 75 Then
                      n = 40
                    Else
                      n = 55
                    End If
                  Else
                    n = 2
                  End If
                  stLine.outerLineWidth = n
                Else
                  x = aF(5, kf)
                  stLine.outerLineWidth = 1
                End If
                Do While Len(x) > 0
                  Select Case UCase(Left(x, 1))
                  Case "A"
                    oBorder.LeftLine   = stLine
                    oBorder.RightLine  = stLine
                    oBorder.TopLine    = stLine
                    oBorder.BottomLine = stLine
                    Exit Do
                  Case "T"
                    oBorder.TopLine    = stLine
                  Case "R"
                    oBorder.RightLine  = stLine
                  Case "B"
                    oBorder.BottomLine = stLine
                  Case "L"
                    oBorder.LeftLine   = stLine
                  End Select
                  x = Mid(x, 2)
                Loop
                If (oRn is Nothing) Then
                  oCell.TableBorder = oBorder
                Else
                  oRn.TableBorder = oBorder
                End If    
              End If

              ' font name
              If aF(6, kf) <> "" Then
                oCell.charFontName=aF(6, kf)
              End If
            
              ' font size
              If aF(7, kf) <> "" Then
                k = Val(aF(7, kf))
                If k > 0 Then
                  oCell.charHeight = k
                End If
              End If

              If Left(aD(3), 1) = "=" Then
                oCell.setFormula(aD(3))
                lFrm = True
              End If
              
            End If
          Else
            ' нет списка форматов
            oCell.String = aD(3)
            oCell.NumberFormat=com.sun.star.util.NumberFormat.TEXT
          End If
        End If
      End If
  '------------------------------------------------
        End If
      End If
OpNext:      
'      Err.Clear
    Loop
    Close nFileNum
    fileAccessService = Nothing
    nFileNum = 0
    fileAccessService.dispose()
'  Else
'    Exit Function
  End If
  On Error GoTo ErrorHandler 
  ' был хоть один wrap ?
  If lWrap Then
    ' wrap был - задаем оптимальную высоту строк
    oSh.Rows.OptimalHeight=True
'  Else
'    If lFmt AND kf>=0 Then
'      oSh.Columns.OptimalWidth=True
'    End If
  End If
  If lFrm Then
    If lCalc Then
      oBook.enableAutomaticCalculation(True)
    Else
      For Each oSh In oBook.Worksheets
        oSh.CalculateAll
      Next
    End If
  End If
  Erase oBook, oSh, oCell, oRn, fileAccessService, oLocale, stLine
  Exit Function

ErrorHandler:
  Erase oBook, oSh, oCell, oRn, fileAccessService, oLocale, stLine
'  msgbox( "Ошибка " & Err & ": " & Error$ & " (строка :" & Erl & ")" )
' возвращается информация об ошибке: номер ; описание ; номер строки
  fillTable = Err & ";" & Error$ & ";" & Erl
  Exit Function
End Function
'-----------------------------------------------
