I'm not sure this isn't overly complicated. and there are some considerations I'm glossing over for the moment. It is an interesting problem though, so I think it's worth tackling.
Working in just one document, one would like to use sheet.CopyRange, but I don't see how that can be made to work across documents. My approach (for now) assumes that the sheet, row, and column coordinates of the source and destination are the same. A real monkey wrench in the works here is the array formulae, which I have attempted to deal with by writing a function to get the entire cellrange of an array formula given one cell in it. Note also that array formulae here should be entirely within the source range.
This has not been exhaustively tested and should be treated with caution, and I have yet to deal with any formatting properties.
Code: Select all
Sub copypaste
Dim mNoArgs() REM Empty Sequence
Dim oThisDocument
Dim oThatDocument
Dim DestinationRange As Object
Dim SourceRange As Object
Dim fCells
Dim oCell As Object
Dim aRange As Object
Dim oSheet
Dim sUrl As String
Dim tUrl As String
oSheet = ThisComponent.Sheets(0)
oDesktop = createUnoService("com.sun.star.frame.Desktop")
sUrl = "file:///C:/Users/DMRC/Documents/Andy R/OpenOffice/Test.ods"
tUrl = "file:///C:/Users/DMRC/Documents/Andy R/OpenOffice/Test2.ods"
oThisDocument = oDesktop.LoadComponentFromURL(sUrl,"_blank",0,mNoArgs)
oThatDocument = oDesktop.LoadComponentFromURL(tUrl,"_blank",0,mNoArgs)
SourceRange = oThisDocument.Sheets(0).getCellRangeByName("D1:O26")
DestinationRange = oThatDocument.Sheets(0).getCellRangeByName(SourceRange.AbsoluteName)
DestinationRange.setDataArray(SourceRange.DataArray)
DestinationRange.setFormulaArray(SourceRange.FormulaArray)
fCells = SourceRange.queryFormulaCells(7)
for each oCell in fCells.Cells
if oCell.ArrayFormula <> "" then
aRange = oThatDocument.Sheets(0).getCellRangeByName(getArrayFormulaRange(OCell,SourceRange).AbsoluteName)
aRange.setArrayFormula(Mid(oCell.ArrayFormula,2,len(oCell.ArrayFormula)-2)
endif
next
End Sub
Function getArrayFormulaRange(oCell As Object, oRange As Object) As Object
Dim fString As String
Dim i As Long
Dim j As Long
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Long
Dim EndCol As Long
Dim FirstArrayRow As Long
Dim LastArrayRow As Long
Dim FirstArrayCol As Long
Dim LastArrayCol As Long
Dim inArray As Boolean
Dim fRange As Object
StartRow = oRange.RangeAddress.StartRow
EndRow = oRange.RangeAddress.EndRow
StartCol = oRange.RangeAddress.StartColumn
EndCol = oRange.RangeAddress.EndColumn
fString = oCell.ArrayFormula
FirstArrayRow = oCell.CellAddress.Row - StartRow
FirstArrayCol = oCell.CellAddress.Column - StartCol
LastArrayRow = FirstArrayRow
LastArrayCol = FirstArrayCol
inArray = True
i = FirstArrayRow
j = FirstArrayCol
do while i >= 0 And inArray
if oRange.getCellByPosition(j,i).ArrayFormula = fString then
FirstArrayRow = i
i = i - 1
else
inArray = False
endif
loop
inArray = True
i = LastArrayRow
do while i <= EndRow - StartRow And inArray
if oRange.getCellByPosition(j,i).ArrayFormula = fString then
LastArrayRow = i
i = i + 1
else
inArray = False
endif
loop
inArray = True
i = FirstArrayRow
j = FirstArrayCol
do while j >= 0 And inArray
if oRange.getCellByPosition(j,i).ArrayFormula = fString then
FirstArrayCol = j
j = j - 1
else
inArray = False
endif
loop
inArray = True
j = LastArrayCol
do while j <= EndCol - StartCol And inArray
if oRange.getCellByPosition(j,i).ArrayFormula = fString then
LastArrayCol = j
j = j + 1
else
inArray = False
endif
loop
getArrayFormulaRange = oRange.getCellRangeByPosition(FirstArrayCol,FirstArrayRow,LastArrayCol,LastArrayRow)
End Function
