[Résolu][Calc] Copier/coller une image

[Scap]

[Edit 28.09-14:24] J'ai trouvé une solution, je vais passer par la copie et le collage d'une plage de cellule comme mentionné ici, comme ce n'est peut-être pas la meilleure solution j'attends de voir si quelqu'un en a une meilleure à me proposer. Je repasserai en parler, ou bien pour effacer ce sujet

Bonjour,

J'ai bien regardé d'autres sujets sur ce forum et je n'ai toujours pas trouvé comment faire ce que je veux.
En m'inspirant notamment de cet exemple et de l'outil pour enregistrer "manuellement" des macros, j'ai écrit le code suivant :

Code : Tout sélectionner

OPTION EXPLICIT
    
Sub CopierColler

    Dim oDoc As Object, oSheet As Object, oDrawPage As Object
    Dim document   As Object
    Dim dispatcher As Object
    Dim args2(0) As New com.sun.star.beans.PropertyValue
    
    oDoc = thisComponent
    oSheet = oDoc.sheets.getByName("Feuille1")
    oDrawPage = oSheet.DrawPage("ImgOooriginale")
    
    thiscomponent.currentcontroller.select(oDrawPage)                        'Sélection de l'image
    
    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())        'Copie de l'image

    'Définition de la cellule de destination
    args2(0).Name = "ToPoint"                                            
    args2(0).Value = "$F$30"                                            
    
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2())    'Sélection de la cellule

    dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())       'Collage de l'image
        
End Sub

Ce code sélectionne bien l'image, fait bien pointer le curseur sur la cellule F30, par contre il ne colle pas l'image...

J'ai aussi pensé à une solution de ce type

Code : Tout sélectionner

OPTION EXPLICIT

Sub CopierColler2

    Dim oDoc As Object
    Dim oDrawPage As Object
    Dim oImage As Object
    Dim i As Integer
    
    oDoc = ThisComponent

    oDrawPage = oDoc.getDrawPages().getByIndex(0) 

    For i=0 To oDrawPage.count-1
        oImage = oDrawPage.getbyindex(i)
        If oImage.Name = "ImgOooriginale" Then Exit For
    Next i

    Dim oGP As Object, oDP As Object
    Dim monGraphique As Object
    Dim oMP(0) As New com.sun.star.beans.PropertyValue
    
    oGP = createUnoservice("com.sun.star.graphic.GraphicProvider")
    oMP(0).Name = "URL"
    oMP(0).value = oImage.GraphicURL

    monGraphique = oGP.queryGraphic(oMP)

' Créer un nouvel objet DrawPage...
'    oDP = oDoc.sheets.getByname("Feuille1").GetDrawpage(i)
'    oDP(i).graphic = monGraphique
    
End Sub

Je voulais copier mon image ImgOOoriginale (qui est dans l'object drawpage de mon document) dans un nouvel object drawpage que je dois créer. (J'ai mis en commentaire parce que je vois bien que mon code ne sert à rien à la fin).
Il me manque encore un truc pour avancer là aussi.

Auriez-vous une idée ou un lien vers un sujet que je n'aurai pas trouvé et qui pourrait me débloquer svp ?

Si jamais :

CopierCollerImage.ods

(désolé pour l'image, j'avais que ça de léger en stock..)

[Edit] J'essaye encore d'une autre façon :

Code : Tout sélectionner

Sub CopyPaste3

	Dim document as object
	Dim oDoc As Object
	Dim oDrawPage As Object
	Dim oImage As Object
	Dim i As Integer
	Dim Img as string

	document = ThisComponent.CurrentController.Frame
	
	oDoc = ThisComponent

	oDrawPage = oDoc.getDrawPages().getByIndex(0) 

	For i=0 To oDrawPage.count-1
		oImage = oDrawPage.getbyindex(i)
		If oImage.Name = "ImgOooriginale" Then Exit For
	Next i

	Img = oImage.GraphicURL

	dim dispatcher as object
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = "ToPoint"
	args1(0).Value = "$F$30"
	dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
	dim args2(2) as new com.sun.star.beans.PropertyValue
	args2(0).Name = "FileName"
	args2(0).Value = Img
	args2(1).Name = "FilterName"
	args2(1).Value = "JPEG - Joint Photographic Experts Group"
	args2(2).Name = "AsLink"
	args2(2).Value = false
	dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args2())
	
End Sub

Le principe est d'insérer une nouvelle image en fonction de l'image originale. Finalement je pense que l'URL récupérée par "Img = oImage.GraphicURL" ne correspond pas à une URL exploitable pour le dispatcher censé insérer l'image. Il me manque quelque chose pour avancer..

[Churay]

Bonsoir

- J'ai compulsé les codes de nos gourOOs, nationaux comme extra-nationaux
- j'ai trouvé plein de trucs autour d'une adresse url, ce qui ne va pas (sauf contournement)

Je ne vois que deux pistes :
Option A
-1.1- récupérer l'image, ce que tu fais (oImage)
-1.2- récupérer son binaire (peut--être avec ll'utilisation de GUID comme décrite par DanyB)
-1.2.1- éventuellement le sauvegarder avec la fonction SaveAfile de DanyB
-1.2.2. récupérer l'image via un loadFromUrl classique si passage par SaveAFile
ou
-1.3- placer l'image via l'API pendant qu'on a son binaire quelque part (1.2)

un peu lourd, non ? Donc Option B : on ruse...
-2- l'image à copier est référencée par une adresse url, ce qui permet d'aller la récupérer de manière simple et donc de la placer un peu ou on veut, la position pouvant se calculer à partie de la cellule active.

Concernant l'option A, je coince au 1.2, après le 1.2.1 et 1.2.2 devraient le faire....
Et au 1.3, je ne vois pas le bout du début du commencement...
Mais ça me plairait assez de voir la soluce (autant elle est immensément simple...)

J'ai cherché, mais mes lacunes persistantes, ne me laissent qu'entrevoir le contournement via l'option B...

Désolé, mais j'ai essayé...

[Scap]

Merci Churay pour tes essais, c'est sympa
J'aurai bien aimé voir une solution plus propre que celle de l'enregistreur de macro..

Si jamais ça vous intéresse voici comment j'ai fait, mais je vous aurais prévenu, c'est du pompage en bonne et due forme (Jack)..

Code : Tout sélectionner

OPTION EXPLICIT

'-'-'-'-''-'-'-'
' Fonction qui copie une plage de cellule sur une feuille et qui la copie sur une autre.
'-'-'-'-''-'-'-'    
Sub CopyPaste
    
    Dim document   As Object
    Dim dispatcher As Object
    Dim args(0) As New com.sun.star.beans.PropertyValue
    
    ' Efface les données présentes dans la zone de "collage"
    EraseCell
    
    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    
    ' Changement de feuille, on accède à la feuille à l'index 1 = "Original"
    args(0).Name = "Nr"
    args(0).Value = 1
    dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args())
    
    ' Sélection de la zone à copier, il faut sélectionner une zone AUTOUR de l'image.
    ' OU ALORS il faut que l'image soit plus petite que la cellule...
    SelectCell ( dispatcher , args(0) , "F16:H23" )
    
    ' Copie de la zone de cellule.
    dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
    
    ' Changement de feuille, on accède à la feuille à l'index 2 = "Destination"
    args(0).Name = "Nr"
    args(0).Value = 2
    dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args())
    
    ' Sélection de la cellule de destination pour le collage
    SelectCell ( dispatcher , args(0) , "F9" )
    
    ' Collage de la zone de cellule
    dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
    
'Xray dispatcher

    ' Sélection d'une cellule quelconque pour éviter une erreur.. magouille
    SelectCell ( dispatcher , args(0) , "A1" )
    
End Sub

'-'-'-'-''-'-'-'
' Supprime le contenu de la plage donnée afin d'éviter de copier coller x fois l'image sur une ancienne
'-'-'-'-''-'-'-'
Sub EraseCell
    Dim oDoc As Object 
    Dim oSheet As Object
    Dim oCell As Object
    
    oDoc = ThisComponent
    oSheet = oDoc.getSheets.getByName("Destination")

    oCell = oSheet.getCellRangeByName( "F9:H16" )
    oCell.clearContents(com.sun.star.sheet.CellFlags.OBJECTS)
End Sub

'-'-'-'-''-'-'-'
' Selectionne une cellule
'-'-'-'-''-'-'-'
Sub SelectCell ( dispatcher As Object, args As New com.sun.star.beans.PropertyValue, cellPos As String )
    args(0).Name = "ToPoint"
    args(0).Value = cellPos
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args())
End Sub

Un des problèmes de cette méthode est qu'il n'est pas possible de copier-coller une image avec sa cellule si l'image est plus grande que la cellule (c'est un peu logique mais quand même c'est dommage). Du coup, on est obligé de sélectionner une zone suffisamment grande autour de l'image pour être sûr de la prendre.

La sélection d'image par quelque chose se rapprochant de son URL aurait été une solution plus élégante.

CopierCollerImage v2.ods

Et je marque résolu pour la forme.. même si..

[Pierre-Yves Samyn]

Bonjour

En m'inspirant notamment de

Très bonne source

Ce code sélectionne bien l'image, fait bien pointer le curseur sur la cellule F30, par contre il ne colle pas l'image...

Dans ton cas non... car tu ne changes pas de feuille (vs le fil précité) et donc le graphique initial reste sélectionné... (ce qui n'empêche pas, en revanche, la sélection de la cellule "cible").

La solution est donc simplement de "forcer" la désélection, par exemple :

Code : Tout sélectionner

option explicit

sub forum

Dim oDoc As Object, oSheet As Object, PysGraph As Object
Dim PysFrame   As Object
Dim dispatcher As Object
dim PysCell as object

oDoc = thisComponent
PysFrame   = oDoc.CurrentController.Frame
oSheet = oDoc.sheets.getByName("Feuille1")
PysGraph = oSheet.DrawPage("ImgOooriginale")
PysCell = oSheet.getCellRangeByName("F30")

oDoc.currentcontroller.select(PysGraph)

dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(PysFrame, ".uno:Copy", "", 0, Array())

oDoc.currentController.select(PysCell)
dispatcher.executeDispatch(PysFrame, ".uno:Paste", "", 0, Array()           
end sub

Nota : j'ai renommé ta variable oDrawPage en PysGraph pour attirer ton attention sur l'importance du choix des noms de variables pour la lisibilité du code...

Tu fais référence à un objet contenu dans la page de dessin, non à une page de dessin

[Churay]

Bonjour

Bin vi... par le dispatcher ça reste quand même moins tordu que là où mes élucubrations ont erré...

Par contre : pourquoi le décalage d'une colonne et une ligne ?

Code : Tout sélectionner

	' Sélection de la cellule de destination pour le collage
	SelectCell ( dispatcher , document , args() , "F9" )

Le collage se fait en G10.

Idem quelle que soit la cellule sélectionnée, il y a toujours +1,+1.

[Pierre-Yves Samyn]

Idem quelle que soit la cellule sélectionnée, il y a toujours +1,+1.

Je ne sais pas d'où est extrait ce code (pas de ma réponse en tout cas...) et je ne reproduis pas cela avec l'exemple donné ci-dessus (collage en F30) :

Capture-1.png

[Scap]

Par contre : pourquoi le décalage d'une colonne et une ligne ?

Code : Tout sélectionner

	' Sélection de la cellule de destination pour le collage
	SelectCell ( dispatcher , document , args() , "F9" )

Le collage se fait en G10.

Si tu exécutes le code pas à pas tu vois que la zone sélectionnée englobe l'image (F9:xx), donc si je veux coller l'image en G10 il faut que je colle la zone sur la cellule décalée en diagonale à gauche.. magouille

Je ne sais pas d'où est extrait ce code (pas de ma réponse en tout cas...) et je ne reproduis pas cela avec l'exemple donné ci-dessus (collage en F30) :

C'est extrait du document que j'ai joint ci-dessus.
Mon code fonctionne aussi mais ta solution est plus propre. Merci pour ce code.
Juste un truc, dans le cas où il y a plusieurs images, je me suis permis de rajouter une boucle de recherche avec test du nom du fichier :

Code : Tout sélectionner

	For i=0 To oSheet.DrawPage.count-1
		PysGraph = oSheet.DrawPage.getbyindex(i)
		If PysGraph.Name = "Logo" Then Exit For
	Next i

[Churay]

yeap

bin non Pierre-Yves ce n'était pas issu de ton code...

Tester les tiens n'est pas marrant : ils fonctionnent... Par contre ils sont riches d'enseignements et là ils valent le coup d'être examinés
Question : n'y a-t-il pas une solution via shape ? (j'ai cherché sans succès)

pour en revenir au bout de code cité précédemment et à
il faut que je colle la zone sur la cellule décalée en diagonale à gauche..
Ca implique qu'il n'est pas possible de coller en colonne A, ni en ligne 1, sauf à passer par l'API après le collage pour réajuster les positions X et Y.

[Scap]

pour en revenir au bout de code cité précédemment et à
il faut que je colle la zone sur la cellule décalée en diagonale à gauche..
Ca implique qu'il n'est pas possible de coller en colonne A, ni en ligne 1, sauf à passer par l'API après le collage pour réajuster les positions X et Y.

C'est possible de coller en A1, il faut alors que l'image qui a été insérée dans la cellule XY soit décalée un chouilla vers le bas droit.. c'est vraiment pas très propre mais ça marche..
Un autre problème se pose s'il y a du texte dans les cellules autour de celle où il y a l'image. Car comme il faut sélectionner une plage de cellule suffisamment large pour la copie, il se peut que le texte se trouve aussi dans cette zone et qu'on le copie aussi pour le coller plus loin (ce qui n'est pas toujours voulu).

[Edit]
Finalement je reviens sur ce sujet car j'ai remarqué un truc "amusant"..
Aucune des deux méthodes ne fonctionne si l'image est dans la feuille 2 et que cette feuille est masquée.. C'est un peu facheux..

CopierGraphique_masquée.ods

Par contre, un code comme ci-dessous ne pose aucun problème (mais ne gère pas les images)

Code : Tout sélectionner

Dim txt As String, aCell As Object
	oDoc = thisComponent
	txt =	oDoc.Sheets(1).GetCellByPosition(1, 5).GetFormula
	aCell = oDoc.Sheets(0).getCellByPosition(4,10)
	aCell.String = txt

Ensuite par rapport à ma méthode, je remarque pas mal de bugs (?) par rapport à la gestion d'image.
1 : J'ai l'impression que la réussite de l'opération est assez aléatoire. En effet parfois l'image est copiée-collée, parfois pas, alors que sa taille n’a pas varié et qu’elle tient toujours dans la cellule.
2 : Ensuite lors de l’impression de mon document, l’image, bien que complètement comprise dans la zone à imprimer, semble déborder et engendre l’impression d’une page supplémentaire..

Bref, je mets résolu parce que j'ai une solution fonctionnelle mais il reste quelques mystères à éclaircir au sujet de ces images et feuilles masquées..