Option Explicit
 
Dim oSM                             As Object    'Root object for accessing 
' OpenOffice from VB --> (ServiceManager)
 
Private Sub cmdLibreOfficeTest_Click()
  Call LibreOfficeTest
End Sub
 
Sub LibreOfficeTest()
  Dim oDesk                         As Object
  Dim oDoc                          As Object
  Dim oSheets                       As Object
  Dim oSheet                        As Object
  Dim oRange                        As Object
  Dim vartest                       As Variant
  Dim strtest                       As String
  Dim strFileName                   As String
 
  Set oSM = CreateObject("com.sun.star.ServiceManager")
  Set oDesk = oSM.createInstance("com.sun.star.frame.Desktop")
 
  Dim OpenParam(3)                  As Object    'Parameters to open the doc
 
  Set OpenParam(0) = mAkePropertyValue2("ReadOnly", False)
  Set OpenParam(1) = mAkePropertyValue2("Hidden", True)
  Set OpenParam(2) = mAkePropertyValue2("FilterName", "calc8")
  Set OpenParam(3) = mAkePropertyValue2("MacroExecutionMode", 4)
  '  Set OpenParam(4) = mAkePropertyValue2("AsTemplate", False)
  '  Set OpenParam(5) = mAkePropertyValue2("overwrite", True)
 
  strFileName = "G:/Test"  'Sonderzeichen nicht erlaubt??
  'Open existing doc
  Set oDoc = oDesk.loadComponentFromURL("file:///" & strFileName & ".ods", _
    "_blank", 0, OpenParam)
 
  MsgBox "Datei geöffnet!"
 
  Set OpenParam(0) = Nothing
  Set OpenParam(1) = Nothing
  Set OpenParam(2) = Nothing
  Set OpenParam(3) = Nothing
  '  Set OpenParam(4) = Nothing
  '  Set OpenParam(5) = Nothing
 
  'Get the Worksheet
  Set oSheets = oDoc.getSheets()
  Set oSheet = oSheets.getByName("Tabelle1")
 
  MsgBox "Arbeitsblatt geöffnet!"
 
  'Read the value of a selected cell
  strtest = oSheet.getCellRangeByName("B1").String  ' = oSelection.String
  'Change the value of a selected cell
  strtest = Date & "*" & Time
  oSheet.getCellRangeByName("B1").String = strtest
  Debug.Print "strtest = " & strtest
 
  MsgBox "Daten geändert!"
 
  'Save the spreadsheet
  Dim SaveParam(0)                  As Object    'Parameters to save the doc
  Set SaveParam(0) = mAkePropertyValue2("FilterName", "calc8")
 
  oDoc.storeAsURL "file:///" & strFileName & "_Neu" & ".ods", SaveParam
 
  Set SaveParam(0) = Nothing
 
  MsgBox "Daten gespeichert! - Neue Datei"
 
  'Save the spreadsheet
  Dim SaveParam2(1)                  As Object    'Parameters to save the doc
  Set SaveParam2(0) = mAkePropertyValue2("FilterName", "calc8")
  Set SaveParam2(1) = mAkePropertyValue2("overwrite", True)
 
  oDoc.storeAsURL "file:///" & strFileName & ".ods", SaveParam
 
  Set SaveParam2(0) = Nothing
  Set SaveParam2(1) = Nothing
 
  MsgBox "Daten gespeichert! - Überschrieben"
 
  oDoc.dispose
  oDesk.Terminate
 
  Set oRange = Nothing
  Set oSheet = Nothing
  Set oSheets = Nothing
  Set oDoc = Nothing
  Set oDesk = Nothing
  Set oSM = Nothing
 
End Sub
 
Public Function mAkePropertyValue2(cName, uValue)
  Dim oStruct                       As Object
 
  Set oStruct = oSM.Bridge_getStruct("com.sun.star.beans.PropertyValue")
  oStruct.Name = cName
  oStruct.Value = uValue
  Set mAkePropertyValue2 = oStruct
 
  Set oStruct = Nothing
 
End Function