Hi,
Question is in the subject. Also I need to copy a range and paste it in another document too with macro. Document's file path will be variable.
Thanks!
[Solved] Copying a cell value to another Calc document
-
- Posts: 5
- Joined: Tue Mar 21, 2017 7:46 am
[Solved] Copying a cell value to another Calc document
Last edited by Hagar Delest on Tue Apr 11, 2017 9:22 pm, edited 1 time in total.
Reason: tagged [Solved].
Reason: tagged [Solved].
OpenOffice 4.1.3 on Windows 10
Re: Copying a cell value to another calc document with macro
Usually I use these functions (sorry they are documented in french) :
You can call it like that
That means you want to copy from the actual document cells A1 to E5 (0, 0, 4, 4) of Sheet1 to the document LOTest in Sheet1 at cell A1 (0,0).
Code: Select all
' Copie une zone d'une feuille donnée dans un autre classeur
' Si les paramètres optionnels ne sont pas renseignés, on copie dans le même classeur
' docArriv doit être de la forme "C:\Users\...\classeur.ods"
' Remarque : si le fichier destination n'existe pas, la copie ne s'effectue pas
'------------------------------------------------------------------------------------
Function CopierCollerToutEntreClasseurs (feuille As String, colI As Integer, ligI As Integer, colF As Integer, ligF As Integer,_
farriv As String, col As Integer, lig As Integer,_
Optional doc As Object, Optional docArriv As String) As Integer
Dim oData As Variant
Dim oFeuille As Object
Dim oPlage As Object
Dim Fichier As String
Dim oDoc1 As Object, oDoc2 As Object
Dim Args() As Variant
If IsMissing(doc) Then
oDoc1 = ThisComponent
Else
oDoc1 = doc
End If
oFeuille = RetourneFeuille(feuille, oDoc1)
If Not IsNull(oFeuille) Then
'on sélectionne la plage à copier
oPlage = oFeuille.getCellRangeByPosition(colI,ligI,colF,ligF)
oDoc1.CurrentController.select(oPlage)
' on copie les données
oData = oDoc1.CurrentController.getTransferable()
' on ouvre le deuxième document
If IsMissing(docArriv) Then
oDoc2 = ThisComponent
Else
Fichier = ConvertToUrl(docArriv)
' ouverture du fichier si existant en mode caché
If FileExists(Fichier) Then oDoc2 = StarDesktop.loadComponentFromURL(Fichier,"_hidden",0 ,Args())
End If
If Not IsNull (oDoc2) Then
'on sélectionne l'endroit où on va coller la plage copiée
oFeuille = RetourneFeuille(farriv, oDoc2)
If Not IsNull (oFeuille) Then
oPlage = oFeuille.getCellByPosition(col, lig)
oDoc2.CurrentController.select(oPlage)
' on colle les données
oDoc2.CurrentController.insertTransferable(oData)
If StrComp(oDoc2.Title, oDoc1.title) <> 0 Then
' on sauvegarde le fichier
oDoc2.store
' on ferme le fichier
oDoc2.close(True)
End If
Else
' on ferme le document si ce n'est pas l'actuel
If len(Fichier) > 0 Then oDoc2.close(True)
' la feuille n'existe pas
CopierCollerToutEntreClasseurs = -3
End If
Else
' le fichier d'arrivée n'existe pas
CopierCollerToutEntreClasseurs = -2
End If
Else
CopierCollerToutEntreClasseurs = -1
End If
End Function
' Retourne un objet Feuille si elle existe à partir de son nom
'-------------------------------------------------------------
Function RetourneFeuille(feuille As String, Optional doc As Object) As Object
Dim oDoc As Object
If IsMissing(doc) Then
oDoc = ThisComponent
Else
oDoc = doc
End If
If IsFeuille(feuille, oDoc) = True Then
RetourneFeuille = oDoc.Sheets.getByName(feuille)
End If
End Function
' Vérifie l'existence d'une feuille
' return True si Ok
' return False si pas Ok
'----------------------------------
Function IsFeuille(feuille As String, Optional Doc As Object) As Boolean
Dim oSheets As Object, oDoc As Object
If IsMissing(Doc) Then
oDoc = ThisComponent
Else
oDoc = Doc
End If
oSheets = oDoc.Sheets
If oSheets.hasByName(feuille) Then
IsFeuille = True
Else
IsFeuille = False
End If
End Function
Code: Select all
CopierCollerToutEntreClasseurs ("Feuille1", 0, 0, 4, 4, "Feuille1", 0, 0 , ThisComponent, "C:\Users\XX\Documents\LOTest.ods")
LibreOffice 5.3.2.1 x 64 and AOO 4.1.3 Windows x64
-
- Posts: 5
- Joined: Tue Mar 21, 2017 7:46 am
Re: Copying a cell value to another calc document with macro
Okay. I've solved it already but new solutions are always good Thanks
OpenOffice 4.1.3 on Windows 10