Re: [fr-users] [BASIC] Comment faire un Copier/Coller avec mise en forme de cellules entre 2 classeurs

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



--
Envoyez un mail à users+help@fr.libreoffice.org pour savoir comment vous désinscrire
Les archives de la liste sont disponibles à http://listarchives.libreoffice.org/fr/users/
Tous les messages envoyés sur cette liste seront archivés publiquement et ne pourront pas être 
supprimés