Codice: Seleziona tutto
Sub CopiaRange
Dim DocName as object, DocUlr as string, dummy(), range as object
Doc = ThisComponent
REM ===========================================================
Rem Acquisisco URL completo relativo a QUALSIASI PC da cui venga avviato il file
Url = Doc.GetUrl()
REM Trovo la posizione dell'ultima / all'interno della stringa dell'URL acquisito automaticamente.
For X = Len(Url) To 1 Step -1
If InStr(X , Url , "/") <> 0 Then
PosizioneUltimaBarra = X
X = 0
End If
Next
UrlSenzaNomeFile = Left(url , PosizioneUltimaBarra)
'MsgBox (UrlSenzaNomeFile , 0 , "URL senza il nome del file") 'Verifica OK
REM ===========================================================
Sheet = Doc.Sheets(0)
Range1 = Sheet.getCellRangeByName("A48:E48").getDataArray ' range da copiare
Dim Args(0) As New com.sun.star.beans.PropertyValue
Args(0).Name = "MacroExecutionMode"
Args(0).Value = com.sun.star.document.MacroExecMode.ALWAYS_EXECUTE_NO_WARN
' DocUrl = ConvertToURL(sFileName)
DocUrl = UrlSenzaNomeFile & "NomeDelFileDell'ArchivoEsterno.ods" ' Url completo del file di destinazione
REM ===========================================================
DocName = StarDesktop.loadComponentFromURL (DocUrl, "_blank",0, Args() )
NomeFile = DocName.Sheets(2)
dRange1 = NomeFile.getCellRangeByName("A48:E48") ' range destinazione
dRange1.setDataArray(Range1)
DocName.store()
Doc.Close(true)
End Sub