Переделать код для OpenOffice.Calc

[dimajak]

Давным-давно написал на VB6 программку, в которой есть вывод данных в таблицу Excel. В связи с проверками на лицензионность MS Office удалили и поставили OpenOffice. Теперь не работает такой код:

Код: Выделить всё

    Set objExcel = GetObject(, "Excel.Application")
    If Err.Number Then
        Err.Clear
        Set objExcel = CreateObject("Excel.Application")
        If Err.Number Then
            MsgBox "Не могу загрузить Excel."
            Exit Sub
        End If
    End If
    Set objWorkbook = objExcel.Workbooks.add
    AppActivate "Реестр отправленных отчетов за "
    objWorkbook.ActiveSheet.Range("A1:N1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .Merge
        .Font.Size = 12
        .Font.Bold = True
    End With
    objWorkbook.ActiveSheet.Range("A1") = "Реестр отправленной отчетности"
    kol_rows = MSFlexGrid1.Rows - 1
    With objWorkbook.ActiveSheet
        For i = 0 To MSFlexGrid1.Rows - 1
            MSFlexGrid1.row = i
            For n = 0 To MSFlexGrid1.Cols - 2
                MSFlexGrid1.col = n
                .Cells(i + 3, n + 1).NumberFormat = "@"
                .Cells(i + 3, n + 1).Font.Size = 10
                .Cells(i + 3, n + 1).Value = MSFlexGrid1.Text
                .Columns(n + 1).AutoFit
            Next
        Next
    End With
    objWorkbook.ActiveSheet.Rows("3:3").Select
    With Selection
        .Font.Size = 12
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    'Рамки
    Range("A3:N" & MSFlexGrid1.Rows + 2).Select
    With Selection
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    With objWorkbook.ActiveSheet
        .Rows("3").Select
        .Columns.AutoFit
    End With
    objWorkbook.ActiveSheet.Cells("1,1").Select
    objExcel.Visible = True
    Set objExcel = Nothing


Помогите его переделать для OpenOffice.Calc.

[GSerg]

В openoffice нет VBA, а управлять им можно через какое-то API для Java.
Тебе не на этот форум.

[Gloom]

Programming OpenOffice.org with Visual Basic

[dimajak]

Спасибо, разобрался.
Все вывел, отформатировал.
Только остался один непонятный момент - как сделать обрамление у ячеек?

[Twister]

А разве в OpenOffice нет функции "записать макрос"?
Запиши и посмотри как он это делает.

[dimajak]

ОК, поставим вопрос иначе.
Имеем (код VB6):

Код: Выделить всё

    Dim oServiceManager As Object
    Dim oDesktop As Object
    Dim oDoc As Object
    Dim aNoArgs()
    Dim oSheets As Object
    Dim oSheet As Object
    Dim oRange As Object

    Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
    Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
    Set oDoc = oDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, aNoArgs())
    Set oSheets = oDoc.getSheets()
    Set oSheet = oDoc.getSheets().getbyIndex(0)
    Set oRange = oSheet.getCellRangeByPosition(0, 2, 13, 61)

т.е., у нас есть объект oRange, как для него установить бордюры (рамки)?
В ОО макрос выглядит так:

Код: Выделить всё

sub Main
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$3:$N$61"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dim args2(12) as new com.sun.star.beans.PropertyValue
args2(0).Name = "OuterBorder.LeftBorder"
args2(0).Value = Array(0,0,2,0)
args2(1).Name = "OuterBorder.LeftDistance"
args2(1).Value = 0
args2(2).Name = "OuterBorder.RightBorder"
args2(2).Value = Array(0,0,2,0)
args2(3).Name = "OuterBorder.RightDistance"
args2(3).Value = 0
args2(4).Name = "OuterBorder.TopBorder"
args2(4).Value = Array(0,0,2,0)
args2(5).Name = "OuterBorder.TopDistance"
args2(5).Value = 0
args2(6).Name = "OuterBorder.BottomBorder"
args2(6).Value = Array(0,0,2,0)
args2(7).Name = "OuterBorder.BottomDistance"
args2(7).Value = 0
args2(8).Name = "InnerBorder.Horizontal"
args2(8).Value = Array(0,0,2,0)
args2(9).Name = "InnerBorder.Vertical"
args2(9).Value = Array(0,0,2,0)
args2(10).Name = "InnerBorder.Flags"
args2(10).Value = 0
args2(11).Name = "InnerBorder.ValidFlags"
args2(11).Value = 127
args2(12).Name = "InnerBorder.DefaultDistance"
args2(12).Value = 0

dispatcher.executeDispatch(document, ".uno:SetBorderStyle", "", 0, args2())


end sub

Как его портировать в VB6?

[dimajak]

Либо как портировать этот код в VB6:

Код: Выделить всё

sub Main

Dim mNoArgs()
Dim sUrl As String
oDesktop=createUnoService("com.sun.star.frame.Desktop")
sUrl="private:factory/scalc"
REM Or: sUrl="file:///home/testuser/Office52/work/table.sdc"
oDocument=oDesktop.LoadComponentFromURL(sUrl,"_blank",0,mNoArgs)

oSheets=oDocument.Sheets()
oSheet=oSheets.getByIndex(0)
Dim range AS Object
Dim aBorder AS Object
Dim aLineBorder As New com.sun.star.table.BorderLine
   
range = oSheet.getCellRangeByPosition(0, 0, 10, 10)
aBorder = range.TableBorder

aLineBorder.OuterLineWidth = 50 ' толщина линии в сотых долях миллиметра
aLineBorder.InnerLineWidth =  0 ' толщина линии в сотых долях миллиметра
aLineBorder.Color = 0

aBorder.IsTopLineValid          = 1
aBorder.IsBottomLineValid       = 1
aBorder.IsLeftLineValid       = 1
aBorder.IsRightLineValid       = 1
aBorder.IsHorizontalLineValid    = 1
aBorder.IsVerticalLineValid    = 1

aBorder.TopLine       = aLineBorder
aBorder.BottomLine       = aLineBorder
aBorder.LeftLine       = aLineBorder
aBorder.RightLine       = aLineBorder
aBorder.HorizontalLine    = aLineBorder
aBorder.VerticalLine    = aLineBorder

range.TableBorder    = aBorder
end sub

[Денис]

dimajak, присоединяюсь:

А разве в OpenOffice нет функции "записать макрос"?
Запиши и посмотри как он это делает.

Я только так с VBA и разбирался (в отсутствие инета, и в 97 офисе хелп по нём был русскояз.)

[GSerg]

Хотелось бы спросить у Twister и VB_D3D_Денис, видели ли они OpenOffice хоть раз в жизни...

[dimajak]

Хотелось бы получить работоспособный код с этой строкой

Код: Выделить всё

Dim aLineBorder As New com.sun.star.table.BorderLine

[Денис]

GSerg
twister не видел. это видно из его фразы. ну а я сообщаю - не видел, и желания нет. и в связи с этим, мне совершенно не интересно, как там устроена система макросов и есть ли она там вообще. если меня посадить за опенофис, я сделаю в нем то, что мне надо. всё.

[tyomitch]

ну а я сообщаю - не видел, и желания нет. ... если меня посадить за опенофис, я сделаю в нем то, что мне надо. всё.

оптимист

[dimajak]

все получилось, всем спасибо!

[iGrok]

GSerg
twister не видел. это видно из его фразы. ну а я сообщаю - не видел, и желания нет. и в связи с этим, мне совершенно не интересно, как там устроена система макросов и есть ли она там вообще. если меня посадить за опенофис, я сделаю в нем то, что мне надо. всё.

Хы.. До сегодняшнего дня я тоже так думал... Промучавшись с ним уже чертову уйму времени пришлось разувериться в этом =)

[Хакер]

iGrok
Постить в тему, в которую не постили 5 месяцев, тем более, если этого особо не требуется - некрасиво. И иногда даже наказуема. Учитывая что неделя "без правил" кончилась.