[BASIC] Comment faire un Copier/Coller avec mise en forme de cellules entre 2 classeurs

Samuel_Mounier_Liste · February 1, 2011, 2:37pm

Bonjour,

Je bloque sur un point assez basic... (Tout est relatif)

Par macro, je n'arrive pas à faire un Copier/Coller qui me conserve les formules et les mises en forme entre 2 classeurs différents.

J'ai tenté avec deux approches sans succès :
- La méthode avec le .CopyRange
Comme sur le code ci-dessous
Sub CopySpreadsheetRange
    oSheet1 = ThisComponent.Sheets.getByIndex(I) ' feuille d'originale
    oSheet2 = oeval2correct.Sheets.getByIndex(I) ' feuille destinataire
    oRangeOrg = oSheet1.getCellRangeByName("A1:C10").RangeAddress ' copie la plage
    oRangeCpy = oSheet2.getCellRangeByName("A1:C10").RangeAddress ' insère la plage
    oCellCpy = oSheet2.getCellByPosition(oRangeCpy.StartColumn,oRangeCpy.StartRow).CellAddress ' Position d'insertion
    oSheet1.CopyRange(oCellCpy, oRangeOrg) ' copie ...
End Sub
Ce code fonctionne presque puisqu'il effectue le Copier/coller dans le même classeur (pas deux différents) alors que l'objet oeval2correct est bien correct.
(Il s'ouvre à l'écran suite à la ligne : oeval2correct = StarDesktop.loadComponentFromURL( sUrl , "_blank", 0, dummy) )

- La méthode qui utilise les DataArray qui recopie bien sur le second document mais en perdant toutes les mises en forme

    Dim PlageDestination as object
    Dim PlageSource as object
    ...
    oeval2correct = StarDesktop.loadComponentFromURL( sUrl , "_blank", 0, dummy)
    ...

    OFeuillesSources = ThisComponent.Sheets()
    OFeuillesDestinations = oeval2correct.Sheets()
    I = 0
    do while I < OFeuillesSources.Count

       FeuilleSource = OFeuillesSources.getByIndex(I)
       FeuilleDestination = OFeuillesDestinations.getByIndex(I)
             PlageSource = FeuilleSource.getCellRangeByName("F1:M250")
       PlageDestination = FeuilleDestination.getCellRangeByName("F1:M250")
             PlageDestination.DataArray = PlageSource.DataArray

I = I + 1
loop

Connaissez-vous une autre technique j'ai tenté l'enregistreur de Macro, mais les opérations effectuées sur le classeur cible ne sont pas enregistré.

Samuel_Mounier_Liste · February 1, 2011, 4:28pm

Samuel Mounier (Liste CGO) a écrit :

Bonjour,

Je bloque sur un point assez basic... (Tout est relatif)

Par macro, je n'arrive pas à faire un Copier/Coller qui me conserve les formules et les mises en forme entre 2 classeurs différents.

J'ai tenté avec deux approches sans succès :

[...]
Finalement je me suis débloqué tout seul en recherchant des similarités
avec ce que j'ai pu trouvé sur Internet et le code de l'enregistrement
de macro.

Le code est certainement plus long que ce qu'il aurait pu être écrit proprement mais bon...

J'ai tout de même pu obtenir un résultat fonctionnel avec ceci.

' *****************************************
' Système de correction de QCM automatique
' *****************************************
' Ce code permet de copier/coller tout ce qui se trouve sur chaque feuille à partir
' du fichier contenant les solutions de la cellule F1 à la fin des données de la feuilles
' pour les recopier sur la feuille de même nom sur l'évaluation à corriger
sub Main

  dim document as object
  dim oeval2correct as object
  dim dispatcher as object
  dim dispatcher2 as object
  dim oFileDialog as object
  dim dummy()
     Dim Args(0) as new com.sun.star.beans.PropertyValue

' instanciation du document source sous forme d'objet
document = ThisComponent.CurrentController.Frame ' le document avec les solution

  dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") ' Activation de Uno sur le 1er environnement

  dispatcher2 = createUnoService("com.sun.star.frame.DispatchHelper") ' Activation de Uno sur le 2nd environnement

  ' instanciation de l'objet boite de dialogue d'ouverture de fichier
  oFileDialog = CreateUnoService( "com.sun.star.ui.dialogs.FilePicker" )
  With oFileDialog
    .Title = "Selectionner l'évaluation à corriger"
         ' il est possible de personnalisé la boite de dialogue (son emplacement d'ouverture, les filtres ici)
  End With

  ' Si un fichier a été sélectionné, et que la boite de dialogue a été fermée par le bouton OK
  If oFileDialog.execute() = com.sun.star.ui.dialogs.ExecutableDialogResults.OK then
      ' Récupération du fichier sélectionné
      sUrl = oFileDialog.Files(0)

         ' Ouverture du fichier et instanciation de l'objet permettant l'accès au fichier ouvert
         oeval2correct = StarDesktop.loadComponentFromURL( sUrl , "_blank", 0, dummy)

         ' Il faut aussi instancier oODS2correct. oeval2correct seul n'est pas suffisent pour la suite
         ' lorsqu'il sera utilisé dans UNO
         oODS2correct = oeval2correct.CurrentController.Frame

         ' Instanciation de l'objet "collection" de feuille
         OFeuillesSources = ThisComponent.Sheets()
         OFeuillesDestinations = oeval2correct.Sheets()

         ' Parcours des feuilles (le fichier solution est similaire à l'évaluation)
         I = 0
         do while I < OFeuillesSources.Count - 1
             ' -1 car il y a une feuille réservé pour le paramètrage enfin de classeur
             ' Cette feuille protégée génére sans cela un alerte de protection

FeuilleSource = OFeuillesSources.getByIndex(I)
FeuilleDestination = oeval2correct.Sheets.getByIndex(I) ' feuille no 2

             'Active la feuille du classeur solution
             args(0).Name = "Nr"
             args(0).Value = I + 1
             ' I + 1 car l'indexation s'effectue à partir de 1 et non pas 0 dans les arguments passés
             dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args())

             ' se place sur la cellule de départ
             args(0).Name = "ToPoint"
             args(0).Value = "$F$1"
             dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args())

             ' Sélectionne jusqu'à la fin
             args(0).Name = "Sel"
             args(0).Value = true
             dispatcher.executeDispatch(document, ".uno:GoToEndOfData", "", 0, args())

             ' Sélectionne jusqu'à la fin
             dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

             'Active la feuille du classeur à corriger (DISPATCHER2)
             args(0).Name = "Nr"
             args(0).Value = I + 1
             dispatcher2.executeDispatch(oODS2correct, ".uno:JumpToTable", "", 0, args())

             ' se place sur la cellule de destination du coller
             args(0).Name = "ToPoint"
             args(0).Value = "$F$1"
             dispatcher2.executeDispatch(oODS2correct, ".uno:GoToCell", "", 0, args())

             ' Colle ce qui a été copié
             dispatcher2.executeDispatch(oODS2correct, ".uno:Paste", "", 0, Array())

             I = I + 1

         loop
         oeval2correct.store

end if

end sub

PS : Ce système de QCM va être très prochainement mis à disposition CC.
Est-ce qu'il existe sur le projet LibO un emplacement pour mettre ce genre d'outils comme pour OOo

A+

Samuel