Rambler's Top100
Российский фонд помощи
Навигация
Главная
MS ACCESS
VB
ASP
PHP
Наши друзья
Поиск
Форум
Лента новостей
Новый сайт

Online
Рассылки Subscribe.Ru
Работа с MS Access
Подписаться письмом
Реклама на сайте
 
Главная arrow MS ACCESS arrow Работа с OpenOffice.org Calc из VBA
Работа с OpenOffice.org Calc из VBA Печать E-mail
Автор osmor   
08.02.2008 г.
Оглавление
Работа с OpenOffice.org Calc из VBA
Страница 2
В статье приведен код демонстрируюйщий некоторые основные приемы работы с 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 StringAs 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 ObjectAs 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))

        Case "ScCellRangeObj"
           CellRangeAddressString = FuncService. _
                 CallFunction("ADDRESS", _
              Array(oCellRng.RangeAddress.StartRow + 1, _
                      oCellRng.RangeAddress.StartColumn + 1))
           CellRangeAddressString = CellRangeAddressString _
                     & ":" & FuncService.CallFunction( _
               "ADDRESS", _
               Array(oCellRng.RangeAddress.EndRow + 1, _
                             oCellRng.RangeAddress.EndColumn + 1))

    End Select

 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/)


Просмотров: 31321

  Коментарии (15)
 11 Написал(а) неясно, в 05:37 08.10.2010
А как реализовать печать ? Такую команду выдает макрорекордер..., но на вызов: 
 
Call disp.executeDispatch(oCalcDoc, ".uno:PrintDefault", "", 0, aNoArgs()) 
 
никак не реагирует
 12 Написал(а) Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script , в 17:52 19.12.2011
А как отформатировать ячейку в Calc пользовательским форматом?
 13 Написал(а) osmor, в 09:38 20.12.2011
olafbond, 
В статье есть 2 способа как изменить формат ячейки
 14 Написал(а) Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script , в 07:45 25.02.2012
Здравствуйте! Не подскажете, как реализовать процедуры скрытия листа книги, т. е. сделать его невидимым ("hide"). Попробовал написать сам, ошибок не выдает, а ничего не происходит....
 15 Написал(а) Jane, в 15:22 14.05.2012
Подскажите, пожалуйста: провести форматирование ячейки (число), чтобы появились 2 знака после запятой?

Добавить коментарий
Имя:
E-mail
Коментарий:



Код:* Code



 
Реклама на сайте
HiProg.com - Технологии программирования
Rambler's Top100 TopList