Page 1 sur 1

[Calc] Copier / coller entre deux classeurs ou feuilles

MessagePublié: 03 Sep 2007 10:28
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   AgrandirRéduire
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.

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

MessagePublié: 06 Fév 2008 16:13
par Dude
DispatchSlot étant une fonction obsolète, j'ai pondu ceci en reprenant le travail de PYS :

Code : Tout sélectionner   AgrandirRéduire
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/ci-joint/fichier/2008/02/06-041406.ods

8)

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

MessagePublié: 28 Nov 2013 16:06
par Dude
Code : Tout sélectionner   AgrandirRéduire
' 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 = oDestFeuille.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   AgrandirRéduire
oPlage = oDoc.CurrentSelection ' Plage sélectionnée
Par :
Code : Tout sélectionner   AgrandirRéduire
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.

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

MessagePublié: 06 Déc 2013 12:22
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   AgrandirRéduire
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+