В статье приведен код демонстрируюйщий некоторые основные приемы работы с OpenOffice.org Calc из MS ACCESS или другого приложения MS Office.
Представлены следующие операции:
Создание новой книги OpenOffice.org Calc
Открытие существующей книги OpenOffice.org Calc
Создание нового листа в книге OpenOffice.org Calc
Запись данных в ячейку
Запись формулы в ячейку
Запись функции в ячейку
Получение ссылки на ячейку или диапазон ячеек по индексу
Получение ссылки на ячейку или диапазон ячеек по имени
Форматирование ячейки или диапазона ячеек 3-мя разными способами
Создание и использование стилей
Рисование рамки ячейки или диапазона ячеек
Добавление/удаление строки/столбца
Изменение имени листа
Удаление листа
Вывод списка всех листов
Сохранение файла в формате OpenOffice.org Calc
Сохранение файла в формате PDF
Option Compare Database
Option Explicit
Public Function Sample_OOO()
'Демонстрирует некоторые приемы работы с OpenOffice.org Calc
'см. комментарии в тексте программы
'Oleg Smorchkov aka osmor специально для www.hiprog.com
'при цитировании ссылка на hiprog.com обязательна
Dim oServiceManager As Object
Dim oDesktop As Object
Dim oCalcDoc As Object
Dim oBook As Object
Dim oSheet As Object
Dim aNoArgs()
Dim oCells As Object
Dim i As Integer
Dim j As Integer
Dim cUrl As String
On Error GoTo Sample_OOO_Error
'создаем новый ServiceManager
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set oCalcDoc = oServiceManager.createInstance("com.sun.star.frame.Desktop")
' создаем новую книгу OpenOffice.org Calc
Set oBook = oCalcDoc.loadComponentFromURL("private:factory/scalc", "_blank", 0, aNoArgs())
'получаем ссылку на первый лист новой книги
Set oSheet = oBook.getSheets().getByIndex(0)
'заполняем первые 10 ячеек первых 10 строк случайными числами от 1 до 1000
' обращение к ячейке происходит по индексу, нумерация с 0
' т.е. чтобы получить ячейку в первом столбце первой строки пишем oSheet.getCellByPosition(0,0)
'кроме того в getCellByPosition первый аргумент столбец, второй строка (в Excel наоборот)
For i = 0 To 9
For j = 0 To 9
Call oSheet.getCellByPosition(i, j).SetFormula(Int(1000 * Rnd + 1))
Next
Next
'Заполняем 11-й столбец (K) формулой вычисляющую сумму ячейки из 9- и 10-й (I и J) колонок
'за минусом ячейки из 7-й (G) колонки для каждой строки
' т.е. для первой строки формула будет "=(I1+ J1)-G1"
'поскольку поддержка ссылок типа R1C1 включена не во все сборки OOo
'используем строковые имена ячеек собирая их "вручную". Не забывая
'что нумерация ячеек в программе идет с 0, а в формулах с 1
'Это не всегда удобно, т.к. "буквы" столбцов заданы в тексте программы
'и в данном случаем приведено просто как возможный вариант
j = 10
For i = 0 To 9
Call oSheet.getCellByPosition(j, i).SetFormula("=(I" & i + 1 & "+ J" & i + 1 & ")-G" & i + 1)
Next
'Заполняем 12-й столбец такой же формулой как и 11-й
'но адреса ячеек получив вспомогательной функцией CellRangeAddressString
'возвращающей строковое представления адреса ячейки
' в этом случае если в последующем эта формула будет в другом столбце
' программу переписывать не придется
j = 11
For i = 0 To 9
Call oSheet.getCellByPosition(j, i).SetFormula("=(" & CellRangeAddressString(oSheet.getCellByPosition(j - 3, i)) & "+ " & CellRangeAddressString(oSheet.getCellByPosition(j - 2, i)) & ")-" & CellRangeAddressString(oSheet.getCellByPosition(j - 5, i)))
Next
'Заполняем 11-ю строку формулой вычисляющую суммы по колонкам
j = 10
For i = 0 To 11
Call oSheet.getCellByPosition(i, j).SetFormula("=SUM(" & CellRangeAddressString(oSheet.getCellRangeByPosition(i, 0, i, j - 1)) & ")")
Next
'------------------------------------------------------------
'покраска ячейки F6 с использованием MakePropertyValue
'------------------------------------------------------------
Dim prop(1) As Object
Dim disp As Object
Set disp = CreateUnoService("com.sun.star.frame.DispatchHelper")
'переход к форматируемой ячейки
Set prop(0) = MakePropertyValue("ToPoint", "$f$6")
Call disp.executeDispatch(oCalcDoc, ".uno:GoToCell", "", 0, prop)
'цвет фона
Set prop(0) = MakePropertyValue("BackgroundPattern.BackColor", 14426880)
Call disp.executeDispatch(oCalcDoc, ".uno:BackgroundPattern", "", 0, prop)
'жирный шрифт
Set prop(0) = MakePropertyValue("Bold", True)
Call disp.executeDispatch(oCalcDoc, ".uno:Bold", "", 0, prop)
'цвет шрифта
Set prop(0) = MakePropertyValue("Color", 7012500)
Call disp.executeDispatch(oCalcDoc, ".uno:Color", "", 0, prop)
'Курсив
Set prop(0) = MakePropertyValue("Italic", True)
Call disp.executeDispatch(oCalcDoc, ".uno:Italic", "", 0, prop)
Set disp = Nothing
'------------------------------------------------------------
' форматирование ячейки "D5" используя свойство ячейки
' ссылку на ячейку получаем по имени методом getCellRangeByName
'------------------------------------------------------------
Set oCells = oSheet.getCellRangeByName("D5")
With oCells
.CellBackColor = RGB(0, 255, 0) 'цвет фона
.CharColor = RGB(255, 0, 0) 'Цвет текста
.CharWeight = 150 'Толщина шрифта
.IsTextWrapped = True ' Переносить по словам
End With
'-------------------------------------------------------------
'форматирование ячейки "E3" с использованием стиля
'стиль можно использовать несколько раз для разных ячеек
'ссылку на ячейку получаем по индексу
'-------------------------------------------------------------
Dim oMyStyle As Object
Set oCells = oSheet.getCellByPosition(4, 2)
Set oMyStyle = oBook.createInstance("com.sun.star.style.CellStyle")
Call oBook.getStyleFamilies().getByName("CellStyles").insertByName("osmorStyle", oMyStyle)
oMyStyle.CellBackColor = RGB(255, 220, 220) ' цвет фона
oMyStyle.IsCellBackgroundTransparent = False
oMyStyle.CharColor = RGB(0, 0, 200) ' цвет шрифта
oMyStyle.CharWeight = 150 ' толщина шрифта
oCells.CellStyle = "osmorStyle" ' применяем стиль к выбранной ячейке
Set oMyStyle = Nothing
'-------------------------------------------------------------
'применение созданного выше стиля "osmorStyle" для форматирования
'диапазона ячеек "K1:L10"
'ссылку на диапазона получаем по имени методом getCellRangeByName
'-------------------------------------------------------------
Set oCells = oSheet.getCellRangeByName("K1:L11")
oCells.CellStyle = "osmorStyle" ' применяем стиль к выбранному диапазону
'-------------------------------------------------------------
'применение созданного выше стиля "osmorStyle" для форматирования
'диапазона ячеек "A11:L11"
'сслыку на диапазона получаем получаем по номерам строк и столбцов методом getCellRangeByPosition
'-------------------------------------------------------------
Set oCells = oSheet.getCellRangeByPosition(0, 10, 11, 10)
oCells.CellStyle = "osmorStyle" ' применяем стиль к выбранному диапазону
'-------------------------------------------------------------
'Рисуем рамку для всех ячеек диапазона "A11:L11"
' используем вспомогательную функцию MakeCellBorderLine
'-------------------------------------------------------------
'левая рамка будет из двух линий
Set oCells.LeftBorder = MakeCellBorderLine(RGB(255, 100, 100), 75, 75, 50)
Set oCells.RightBorder = MakeCellBorderLine(RGB(255, 100, 100), 0, 75, 0)
Set oCells.TopBorder = MakeCellBorderLine(RGB(255, 100, 100), 0, 75, 0)
Set oCells.BottomBorder = MakeCellBorderLine(RGB(255, 100, 100), 0, 75, 0)
'вставляем одну строку перед первой строкой (строка с индексом 0)
'первый аргумент индекс вставляемой строки, второй - количество строк
Call oSheet.Rows.insertByIndex(0, 1)
'Удаляем столбец "B"
'первый аргумент индекс удаляемого столбца, второй - количество столбцов
Call oSheet.Columns.removeByIndex(1, 1)
' переименуем лист, в который мы выводили данные
oSheet.Name = "Новый лист"
' создадим новый лист после текущего
Call oBook.getSheets.InsertNewByName("ЕщеНовыйЛист", findSheetIndex(oBook, oSheet.Name) + 1)
'Выводим в окно Immediate список всех листов книги
ListSheetName oBook
'удаляем 3-й лист (лист с именем "Лист2" и индексом 2)
Call oBook.getSheets.removeByName(oBook.getSheets.getByIndex(2).Name)
'сохраняем созданную книгу в формате
'Электронной таблицы OpenDokument
'в корне диска С: с именем SampleOOo.ods
cUrl = ConvertToUrl("c:\SampleOOo" + ".ods")
Call oBook.storeToURL(cUrl, aNoArgs)
'сохраняем созданную книгу в формате PDF
'в корне диска С: с именем SampleOOo.PDF
cUrl = ConvertToUrl("c:\SampleOOo" + ".pdf")
Set prop(0) = MakePropertyValue("FilterName", "calc_pdf_Export")
Call oBook.storeToURL(cUrl, prop)
'закрываем созданную книгу
Call oBook.Close(False)
'Открываем только что сохраненную книгу
cUrl = ConvertToUrl("c:\SampleOOo" + ".ods")
Set oBook = oCalcDoc.loadComponentFromURL(cUrl, "_blank", 0, aNoArgs())
Set oBook = Nothing
Set oSheet = Nothing
Set oCalcDoc = Nothing
Set oServiceManager = Nothing
On Error GoTo 0
Exit Function
Sample_OOO_Error:
Select Case Err.Number
Case 1001
MsgBox "Ошибка при сохранении файла, файл занят другим приложением"
Case Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Sample_OOO"
End Select
End Function
'вспомогательные функции
Public Function CreateUnoService(strServiceName) As Object
'Создание объекта UnoService
Dim oServiceManager As Object
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set CreateUnoService = oServiceManager.createInstance(strServiceName)
End Function
Function MakePropertyValue(cName, uValue) As Object
'создание объекта Property и присвоение ему значения
Dim oPropertyValue As Object
Dim oSM As Object
Set oSM = CreateObject("com.sun.star.ServiceManager")
Set oPropertyValue = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
oPropertyValue.Name = cName
oPropertyValue.Value = uValue
Set MakePropertyValue = oPropertyValue
End Function
Function MakeCellBorderLine(nColor, nInnerLineWidth, nOuterLineWidth, nLineDistance) _
As Object
'Функция создания объекта BorderLine содержащего информацию о линии рамки
'параметры nColor - цвет рамки
'nInnerLineWidth - толщина внутренней линии
' nOuterLineWidth - - толщина внутренней линии
' расстояние между внутренней и внешней линией
Dim oSM As Object
Dim oBorderLine As Object
Set oSM = CreateObject("com.sun.star.ServiceManager")
Set oBorderLine = oSM.Bridge_GetStruct("com.sun.star.table.BorderLine")
With oBorderLine
.Color = nColor
.InnerLineWidth = nInnerLineWidth
.OuterLineWidth = nOuterLineWidth
.LineDistance = nLineDistance
End With
Set MakeCellBorderLine = oBorderLine
End Function
Public Sub ListSheetName(oDoc As Object)
'Выводит имена и индексы всех листов книги переданной в качестве параметра
Dim i As Integer
On Error GoTo ListSheetName_Error
For i = 0 To oDoc.Sheets.Count - 1
Debug.Print "Лист индекс "; i; " называется "; oDoc.Sheets.getByIndex(i).Name
Next
On Error GoTo 0
Exit Sub
ListSheetName_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ListSheetName"
End Sub
Function findSheetIndex(oDoc As Object, sheetName As String) As Integer
'возвращает индекс листа книги переданной в качестве параметра по его имени
Dim i As Integer
For i = 0 To oDoc.Sheets.Count - 1
If oDoc.Sheets.getByIndex(i).Name = sheetName Then
findSheetIndex = i
Exit Function
End If
Next i
findSheetIndex = -1
End Function
Function CellRangeAddressString(oCellRng As Object) As String
'возвращает символьный адрес переданной ячейки или диапазона
Dim FuncService As Object
Set FuncService = CreateUnoService("com.sun.star.sheet.FunctionAccess")
Select Case oCellRng.getImplementationName()
Case "ScCellObj"
CellRangeAddressString = FuncService.CallFunction( _
"ADDRESS", _
Array(oCellRng.CellAddress.Row + 1, _
oCellRng.CellAddress.Column + 1))
End Function
Public Function ConvertToUrl(strFile) As String
'конвертирует путь MS Windows в URL (RFC 1738)
strFile = Replace(strFile, "\", "/")
strFile = Replace(strFile, ":", "|")
strFile = Replace(strFile, " ", "%20")
strFile = "file:///" + strFile
ConvertToUrl = strFile
End Function
При написании использовались материалы сайта http://www.oooforum.org/
Код тестировался на OpenOffice.org 2.2.1 Pro сборка ООО «Инфра-ресурс» (http://www.i-rs.ru/)
Коментарии (15)