[Calc] Copier / coller entre deux classeurs ou feuilles

Vos meilleures macros et portions de code sont publiées dans cette section.
Aucun support sur une question de programmation ici !

Modérateur : Vilains modOOs

Règles du forum
Aucune question dans cette section !
Celle-ci rassemble les meilleures macros et portions de code. Vous pouvez en revanche commenter ou argumenter le code exposé. Vous pouvez même remercier l'auteur (cela fait toujours plaisir) en indiquant par exemple dans quel cadre ou contexte vous en avez eu l'utilité.
Si vous avez à poster quelque chose, faites-le depuis la section Macros et API et demandez à un modérateur de l'y déplacer.
Avatar de l’utilisateur
chater
Membre cOOnfirmé
Membre cOOnfirmé
Messages : 237
Inscription : 21 févr. 2006 14:43
Localisation : Paname

[Calc] Copier / coller entre deux classeurs ou feuilles

Message par 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.
OOo 3.1 officielle sous Ubuntu 9.04

Pensez à aider les autres en répondant à leurs questions.
Avatar de l’utilisateur
Dude
IdOOle de la suite
IdOOle de la suite
Messages : 25143
Inscription : 03 mars 2006 08:45
Localisation : 127.0.0.1
Contact :

[Calc] Copier / coller d'une plage dans un nouveau classeur

Message par 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

8)
Avatar de l’utilisateur
Dude
IdOOle de la suite
IdOOle de la suite
Messages : 25143
Inscription : 03 mars 2006 08:45
Localisation : 127.0.0.1
Contact :

[Calc] Copier / coller entre deux feuilles de la sélection

Message par 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.
Dernière modification par Dude le 11 sept. 2020 12:12, modifié 1 fois.
Piaf
GourOOu
GourOOu
Messages : 5622
Inscription : 25 nov. 2011 19:07
Localisation : Guyane

[Calc] Copier/Coller direct entre 2 feuilles ou classeurs

Message par 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+
Pièces jointes
Transfert.ods
(11.46 Kio) Téléchargé 1825 fois
Libre Office Version: 6.1.6 et Apache OpenOffice 4.1.6 Sur Xubuntu 18.04 AMD64
Verrouillé