[Calc] Copier / coller entre deux classeurs ou feuilles

[chater]

Voici une macro qui copie le contenu d'une plage de cellules, crée un nouveau classeur et colle le tout.

Code : Tout sélectionner

sub CopieDansNouveauClasseur
	
	GlobalScope.BasicLibraries.LoadLibrary("Tools")
	dim NoArgs()
	oDesktop = createUnoService("com.sun.star.frame.Desktop")

    oCeClasseur = thisComponent
	oFeuille = oCeClasseur.Sheets.getByName("Feuille1")
	' Copie de A1 jusqu a D4
    oPlage = oFeuille.getCellRangeByPosition(0,0,3,3)
    oCeClasseur.CurrentController.Select(oPlage)
    DispatchSlot(5711)
       
    oClasseurNeuf = oDesktop.loadComponentFromURL("private:factory/scalc",_
"_blank",0,NoArgs())
    oFeuilleN = oClasseurNeuf.Sheets.getByName("Feuille1")
    ' On remet la meme plage pour ne pas avoir de message d erreur
    oCopie = oFeuilleN.getCellrangeByPosition(0,0,3,3)  
    oClasseurNeuf.CurrentController.Select(oCopie)
    DispatchSlot(5712)
    
end sub

Espérant que cela puisse aider d'autres personnes.

[Dude]

DispatchSlot étant une fonction obsolète, j'ai pondu ceci en reprenant le travail de PYS :

Code : Tout sélectionner

Sub ActionCopieColle
	
	Dim oDoc as object
	Dim origDocument as object
	Dim destDocument as object
	Dim origDispatcher as object
	Dim destDispatcher as Object
	dim oDesktop as Object
	Dim args(0) as new com.sun.star.beans.PropertyValue
	Dim props(0) as new com.sun.star.beans.PropertyValue
	Dim cURL as String
	Dim origLigne as Integer
	Dim destLigne as Integer
	
	origDocument   = ThisComponent.CurrentController.Frame
	origDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	
	oDesktop = createUnoService( "com.sun.star.frame.Desktop" )
	cURL = ConvertToURL( "private:factory/scalc" )
	oDoc = oDesktop.loadComponentFromURL(cURL , "_blank", 0, args() )
	destDispatcher = createUnoService("com.sun.star.frame.DispatchHelper") 
	destDocument = oDoc.CurrentController.Frame
	
	origLigne = 1 ' copie la ligne 1
	destLigne = 10 ' vers la ligne 10
	props(0).Name = "ToPoint"
	' part de la colonne A jusqu'à D
	props(0).Value = "$A$"+origLigne+":$D"+origLigne
	
	origDispatcher.executeDispatch(origDocument, ".uno:GoToCell", "", 0, props()) 
	origDispatcher.executeDispatch(origDocument, ".uno:Copy", "", 0, Array()) 
	
	props(0).Name = "ToPoint"
	props(0).Value = "$A$"+destLigne+":$D"+destLigne
	
	destDispatcher.executeDispatch(destDocument, ".uno:GoToCell", "", 0, props()) 
	destDispatcher.executeDispatch(destDocument, ".uno:Paste", "", 0, Array())
	
end sub

Et le classeur qui va avec :
http://user.services.openoffice.org/fr/ ... 041406.ods

[Dude]

Code : Tout sélectionner

' Collage de plusieurs cellules sélectionnées sur une autre feuille
Sub CollageSelection
	oDoc = ThisComponent
	oPlage = oDoc.CurrentSelection ' Plage sélectionnée
	oColleFeuille = oDoc.Sheets.getByName("Feuille2") ' Nom de la feuille où coller
	oColleCellule = oColleFeuille.getCellRangeByName("C10")  ' Cellule où démarre le collage
	' Test s'il y a bien sélection d'une cellule ou d'une plage
	If oPlage.supportsService("com.sun.star.table.CellRange") Then
	   oColleFeuille.copyRange(oColleCellule.CellAddress, oPlage.RangeAddress)
	Else
	   ' A compléter si plages discontigües
	   msgBox "Sélectionnez au moins deux cellules contigües"
	EndIf
End Sub

Si vous souhaitez copier sans qu'il y ait de sélection, modifiez alors la ligne :

Code : Tout sélectionner

oPlage = oDoc.CurrentSelection ' Plage sélectionnée

Par :

Code : Tout sélectionner

oCopieFeuille= oDoc.Sheets.getByName("Feuille1") ' Nom de la feuille à copier
oPlage = oCopieFeuille.getCellRangeByName("A1:F10") ' La plage à copier

Rappel : on ne peut pas faire cette opération sur des plages discontigües.
Dans ce cas, il faut "mémoriser" chaque plage au préalable.

[Piaf]

Bonjour


Une façon différente de copier une zone de cellules d'une feuille à l'autre ou d'un classeur à un autre sans passer par le presse papier.

Code : Tout sélectionner

Sub CopyZoneMemeClasseur()
Dim oDoc as Object, oRange as Object, aCopier as Object
	oDoc = thisComponent
	oRange = oDoc.Sheets(0).getCellRangeByName("A1:D1") ' la zone à copier
	oDoc.CurrentController.select(oRange) 'Sélection de la zone
	aCopier = oDoc.CurrentController.getTransferable() 'Copie
	oRange = oDoc.Sheets(1).getCellRangeByName("A1") 'Première cellule pour recopie de la zone
	oDoc.CurrentController.select(oRange) 'Selection de la cellule
	oDoc.CurrentController.insertTransferable(aCopier) 'Transfert des données
End Sub

Testé sous AOO 4.0.1 et LibO 4.1.3.2
Le classeur test avec un exemple pour la copie d'un classeur à un nouveau classeur et un exemple pour la copie de sélections multiples.
A+