Apache OpenOffice Community Forum

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