[Résolu][Calc] Générer une copie écran d'une plage

[Grande Ourse]

Bonjour,
À la feuille Brassage, l'onglet "stock" des grains sert à afficher momentanément (image dynamique) ce qu'il y a en inventaire sur la feuille Stock entre les colonnes A3 @ C25. Cette image peut être modifier dans le temps en fonction de l'inventaire. Voir la vidéo de l'auteur du tableur entre les minutes 13:12 @ 14:00 https://youtu.be/VcwZtGPQMKc

Le code actuel est du VBA et je voudrais le porter en Basic.

Quelqu'un aurait t'il une piste pour la création de ce code.


Merçi.

[Dude]

Salut,

Evite de nous envoyer un document trop complexe à étudier.
Fais l'effort de simplifier au maximum comme je le fais avec le classeur joint.

La macro suivante place dans une cellule, la copie écran d'une plage :

Code : Tout sélectionner

Sub CaptureImage()
	sFeuilO = "Feuille2" 'nom de la feuille d'origine
	sPlage = "A1:C5" 'plage sur la feuille d'origine
	sFeuilD = "Feuille1" 'nom de la feuille destination
	sAdr = "B6" 'cellule de destination

	oDoc = thisComponent
	oFeuil = oDoc.Sheets.getByName(sFeuilO)
	oPlage = oFeuil.getCellRangeByName(sPlage)
	oCtrl = oDoc.CurrentController
	oCtrl.select(oPlage) 
	Call ExecuteDispatcher(oDoc, "Copy")
	oFeuil = oDoc.Sheets.getbyName(sFeuilD)
	oPlage = oFeuil.getCellRangeByName(sAdr)
	oCtrl.select(oPlage)
	Dim args1(0) As New com.sun.star.beans.PropertyValue
	args1(0).Name = "SelectedFormat"
	args1(0).Value = 2 'format image BMP
	Call ExecuteDispatcher(oDoc, "ClipboardFormatItems", args1)
End sub

Sub ExecuteDispatcher(oDoc, sNom, Optional args())
	If IsMissing(args) Then args = Array()
	oCadre = oDoc.CurrentController.Frame
	oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
	oDisp.executeDispatch(oCadre, ".uno:" & sNom, "", 0, args)
End Sub

[Grande Ourse]

Bonjour Dude,

Merçi pour le code; cela fonctionne bien pour l'affichage; mais lorsque je clic à nouveau sur le bouton pour l'effacer les poignées de l'image et le mot image1 demeure.

Serait-il possible d'effacer tout les repères de l'image (poignées et texte-image) lorsque je clic sur le bouton pour effacer l'image.

J'ai transposer ton code pour mon application, l'affichage fonctionne bien.

Code : Tout sélectionner

REM  *****  BASIC  *****

Sub PlageVersImage1()
sFeuilO = "Stock" 'nom de la feuille d'origine		
    sPlage1 = "A4:C25" 'plage sur la feuille d'origine 
   	sFeuilD = "Brassage" 'nom de la feuille destination 
   	sAdr1 = "P13" 'cellule de destination	
	
	oDoc = thisComponent
	oFeuil = oDoc.Sheets.getByName(sFeuilO)
	oPlage = oFeuil.getCellRangeByName(sPlage1)
	oCtrl = oDoc.CurrentController
	oCtrl.select(oPlage) 
	Call ExecuteDispatcher(oDoc, "Copy")
	oFeuil = oDoc.Sheets.getbyName(sFeuilD)
	oPlage = oFeuil.getCellRangeByName(sAdr1)
	oCtrl.select(oPlage)
	Dim args1(0) As New com.sun.star.beans.PropertyValue
	args1(0).Name = "SelectedFormat"
	args1(0).Value = 2 'format image BMP
	Call ExecuteDispatcher(oDoc, "ClipboardFormatItems", args1)
End sub

Sub PlageVersImage2()
sFeuilO = "Stock" 'nom de la feuille d'origine		
    sPlage2 = "H4:K21" 'plage sur la feuille d'origine
   	sFeuilD = "Brassage" 'nom de la feuille destination  
   	sAdr2 = "P38" 'cellule de destination	
	
	oDoc = thisComponent
	oFeuil = oDoc.Sheets.getByName(sFeuilO)
	oPlage = oFeuil.getCellRangeByName(sPlage2)
	oCtrl = oDoc.CurrentController
	oCtrl.select(oPlage) 
	Call ExecuteDispatcher(oDoc, "Copy")
	oFeuil = oDoc.Sheets.getbyName(sFeuilD)
	oPlage = oFeuil.getCellRangeByName(sAdr2)
	oCtrl.select(oPlage)
	Dim args1(0) As New com.sun.star.beans.PropertyValue
	args1(0).Name = "SelectedFormat"
	args1(0).Value = 2 'format image BMP
	Call ExecuteDispatcher(oDoc, "ClipboardFormatItems", args1)
End sub

Sub PlageVersImage3()
sFeuilO = "Stock" 'nom de la feuille d'origine		
    sPlage3 = "P4:Q25" 'plage sur la feuille d'origine	
   	sFeuilD = "Brassage" 'nom de la feuille destination  	
    sAdr3 = "P61" 'cellule de destination

	oDoc = thisComponent
	oFeuil = oDoc.Sheets.getByName(sFeuilO)
	oPlage = oFeuil.getCellRangeByName(sPlage3)
	oCtrl = oDoc.CurrentController
	oCtrl.select(oPlage) 
	Call ExecuteDispatcher(oDoc, "Copy")
	oFeuil = oDoc.Sheets.getbyName(sFeuilD)
	oPlage = oFeuil.getCellRangeByName(sAdr3)
	oCtrl.select(oPlage)
	Dim args1(0) As New com.sun.star.beans.PropertyValue
	args1(0).Name = "SelectedFormat"
	args1(0).Value = 2 'format image BMP
	Call ExecuteDispatcher(oDoc, "ClipboardFormatItems", args1)
End sub

Sub ExecuteDispatcher(oDoc, sNom, Optional args())
	If IsMissing(args) Then args = Array()
	oCadre = oDoc.CurrentController.Frame
	oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
	oDisp.executeDispatch(oCadre, ".uno:" & sNom, "", 0, args)
End Sub

J'aimerai utiliser les évènements "souris intérieur" et souris extérieur pour afficher et effacer les images; mais je ne sais pas comment modifier le code,
Je crois que ce doit être le Dispatcher qui est la clé. J'ai chercher depuis 2 jours mais je n'ai pas trouvé .

Merçi encore pour toute l'aide.


Salutations,

[Dude]

mais lorsque je clic à nouveau sur le bouton pour l'effacer les poignées de l'image et le mot image1 demeure.

Où ça ? Comment reproduire ? Avec quel document (pourquoi en fournir deux) ?
Encore une fois, c'est agaçant mais fais l'effort de te mettre à notre place.

J'aimerai utiliser les évènements "souris intérieur" et souris extérieur pour afficher et effacer les images

Je t'ai déjà répondu sur ce point :

Pas besoin de macro pour ça. Il suffit de mettre une image en commentaire.

Car l'événement n'existe pas au niveau de la feuille.
Un contournement est d'utiliser également un contrôle (par exemple un bouton).
Principe expliqué ici : viewtopic.php?t=51013
Mais là encore, je ne vois plus le rapport avec le fait de générer une copie écran de plage.

[Grande Ourse]

Bonjour Dude,
Commençons avec le document Capture_plage_image_Beerxcel_bouton souris enfoncé.ods
Dans ce cas ci je ne suis pas certain que ce soit un bouton ou une étiquette que nous pouvons cliquer.

Test A) Cliquer sur "Inventaire grains", "inventaire houblons", "inventaire levures" fait apparaître les images correspondantes avec son cadre et ses
poignées aux endroits voulus.
Pour effacer l'image avec son cadre et ses poignées je dois utiliser la touche "suppime" au clavier, ce qui permet de cliquer à nouveau sur
"inventaire grains" et "autres" pour faire réapparaître l'image concernée.

Test B) Cliquer sur "Inventaire grains", "inventaire houblons", "inventaire levures" fait apparaître les images correspondantes avec son cadre et
ses poignées aux endroits voulus.
Si je clique à nouveau sur "Inventaire grains" et "autres" l'image disparait mais le cadre et ses poignées demeurent en place; ce qui
empêche l'insertion de l'image à nouveau suite à un troisième clic.

Donc ce que je voudrais c'est: 1er clic fait apparaître l'image, 2e clic efface l'image inclant son cadre et ses poignées, 3e clic fait réapparaître l'image et ainsi de suite.

Concernant le document Capture_plage_image_Beerxcel_souris intérieur-souris extérieur.ods cela aurait pu être une autre manière d'arriver au même résultat ? si réalisable!

Le document c'est un créateur de recette de bière, et l'image est un reflet du contenu de l'inventaire de certains produits, cet inventaire est évolutif comme tout inventaire, c'est pourquoi une image fixe en commentaire n'est pas approprié. En ouvrant ces images dans le créateur de recette cela me permet de visualiser les ingrédients disponibles et leurs quantités et de les utiliser ou non dans la nouvelle recette, cela évite de passer d'un onglet à l'autre.

Merçi de votre patience.


Salutations,

[Jeff]

Bonjour à tous,

Hors macro, ça me fait penser à ce sujet :
Visionneuse de feuilles d'un classeur


C'est l'effet que tu souhaites obtenir ?

A +

[Grande Ourse]

Bonjour Jeff,
J'ai téléchargé l'extension mais ce n'est pas tout à fait cela.

C'est une visualisation partielle d'une feuille sur une autre feuille.

En fait, sur la feuille "Brassage" l'étiquette Inventaire grains sur un clic doit afficher les cellules A4:C25 de la feuille "Stock" puis doit disparaître (s'effacer) lorsque nous cliquons à nouveau sur l'étiquette inventaire grains.

Le code que Dude a fourni fonctionne très bien pour l'affichage, mais il reste le problème de l'effacement.

Salutations,

[Dude]

Le code que Dude a fourni fonctionne très bien pour l'affichage, mais il reste le problème de l'effacement.

Il te reste donc à utiliser XRay pour comprendre.
Les objets graphique se trouvent accessibles sur la couche de dessin (DrawPage).
Il faut boucler dessus et supprimer celle qui doit l'être :

[Grande Ourse]

Bonjour Dude,

Merçi pour le chemin à suivre.

J'ai téléchargé et installé Xray, j'étudie le tout et vous revient.


Salut,

[Grande Ourse]

Bonjour Dude,

J'ai installé et chargé Xray Tools, mais je n'ai pas réussi à l'activer, bien que j'ai lu attentivement le tutoriel, je n'ai pas trouvé la solution.

J'ai trouvé içi https://stackoverflow.com/questions/46048667/how-to-delete-all-images-from-all-sheets-of-a-libreoffice-calc-workbook du code que j'ai ajouté à la fin de mon code mais cela ne semble pas fonctionné.

Code : Tout sélectionner

Sub DeleteAllPics()
    Dim oDoc As Object
    Dim oDrawPage As Object
    Dim oShape As Object
    Dim iShape As Integer
    Dim iSheet As Integer
    oDoc = ThisComponent
    For iSheet = 0 To oDoc.getSheets().getCount() - 1
        oDrawPage = oDoc.getSheets().getByIndex(iSheet).getDrawPage()
        For iShape = oDrawPage.getCount() - 1 To 0 Step -1
            oShape = oDrawPage.getByIndex(i)
            oDrawPage.remove(oShape)
        Next iShape
    Next iSheet
End Sub

Voilà ou j'en suis:
REM ***** BASIC *****

Code : Tout sélectionner

Sub Main
Xray ThisComponent
End Sub

Sub  Image()
        GlobalScope.BasicLibraries.localLibrary("XrayTool")
        
        oDoc = thisComponent
        oFeuil = oDoc.Sheets.getByName("Brassage")
        oDessin = oFeuil.getDrawPage()
        xray oDessin
 End Sub

Sub PlageVersImage1() 'capture image1
sFeuilO = "Stock" 'nom de la feuille d'origine		
    sPlage1 = "A4:C25" 'plage sur la feuille d'origine 
   	sFeuilD = "Brassage" 'nom de la feuille destination 
   	sAdr1 = "P13" 'cellule de destination	
	
	oDoc = thisComponent
	oFeuil = oDoc.Sheets.getByName(sFeuilO)
	oPlage = oFeuil.getCellRangeByName(sPlage1)
	oCtrl = oDoc.CurrentController
	oCtrl.select(oPlage) 
	Call ExecuteDispatcher(oDoc, "Copy")
	oFeuil = oDoc.Sheets.getbyName(sFeuilD)
	oPlage = oFeuil.getCellRangeByName(sAdr1)
	oCtrl.select(oPlage)
	Dim args1(0) As New com.sun.star.beans.PropertyValue
	args1(0).Name = "SelectedFormat"
	args1(0).Value = 2 'format image BMP
	Call ExecuteDispatcher(oDoc, "ClipboardFormatItems", args1)
End sub

Sub ExecuteDispatcher(oDoc, sNom, Optional args())
	If IsMissing(args) Then args = Array()
	oCadre = oDoc.CurrentController.Frame
	oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
	oDisp.executeDispatch(oCadre, ".uno:" & sNom, "", 0, args)
End Sub

[Dude]

mais cela ne semble pas fonctionné

Encore et toujours...

[Grande Ourse]

Bonjour,
Désolé j'avais oublié de joindre le ficher.

Merçi Dude.

[Dude]

Mouais, a priori tu t'obstines à

nous envoyer un document trop complexe à étudier.

Le classeur joint fait l'opération en s'assurant que l'image n'existe pas déjà puis l'efface si besoin.
Pour mémoriser l'information, on se sert d'une propriété personnalisée du document :

Code : Tout sélectionner

Sub PlageVersImage()
	sFeuilO = "Feuille2" 'nom de la feuille d'origine
	sPlage = "A1:C5" 'plage sur la feuille d'origine
	sFeuilD = "Feuille1" 'nom de la feuille destination
	sAdr = "B6" 'cellule de destination
	sCapture = "Capture" 'nom pour la copie écran

	oDoc = thisComponent
	oFeuil = oDoc.Sheets.getByName(sFeuilO)
	oPlage = oFeuil.getCellRangeByName(sPlage)
	oCtrl = oDoc.CurrentController
	oCtrl.select(oPlage) 
	Call ExecuteDispatcher(oDoc, "Copy")
	oFeuil = oDoc.Sheets.getbyName(sFeuilD)
	oPlage = oFeuil.getCellRangeByName(sAdr)
	oCtrl.select(oPlage)
	Dim args1(0) As New com.sun.star.beans.PropertyValue
	args1(0).Name = "SelectedFormat"
	args1(0).Value = 2 'format image BMP
	'Vérif si une image n'a pas déjà été insérée
	VerifCapture(oDoc, oFeuil, sCapture)
	Call ExecuteDispatcher(oDoc, "ClipboardFormatItems", args1)
	'Mémorisation qu'une image a été insérée
	EnregCapture(oDoc, oFeuil, sCapture)
End sub

Sub EnregCapture(oDoc, oFeuil, sNom)
	'Uniquement les images
	sType = "com.sun.star.drawing.GraphicObjectShape"
	oPage = oFeuil.getDrawPage()
	for i = 0 to oPage.Count -1
		oForme = oPage.getByIndex(i)
		if oForme.supportsService(sType) then sVal = oForme.Name	
	next

	with oDoc.DocumentProperties.UserDefinedProperties
		if .getPropertySetInfo().hasPropertyByName(sNom) = false then
			.addProperty(sNom,128,"")
		end if
		.setPropertyValue(sNom, sVal)
	end with
End sub

Sub ExecuteDispatcher(oDoc, sNom, Optional args())
	If IsMissing(args) Then args = Array()
	oCadre = oDoc.CurrentController.Frame
	oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
	oDisp.executeDispatch(oCadre, ".uno:" & sNom, "", 0, args)
End Sub

Sub VerifCapture(oDoc, oFeuil, sNom)
	with oDoc.DocumentProperties.UserDefinedProperties
		if .getPropertySetInfo().hasPropertyByName(sNom) = false then
			.addProperty(sNom,128,"")
		end if
		sVal = .getPropertyValue(sNom)
	end with
	if Len(sVal) = 0 then exit sub
		sType = "com.sun.star.drawing.GraphicObjectShape"
	oPage = oFeuil.getDrawPage()
	for i = 0 to oPage.Count -1
		oForme = oPage.getByIndex(i)
		if sVal = oForme.Name then oPage.remove(oForme)
	next
End sub

[Grande Ourse]

Bonjour Dude,

J'ai compris lorsque tu dis utiliser un fichier simplifié.

Merçi beaucoup pour la proposition.

J'ai fait quelques test.
1) " Feuille 1 "Je clic sur le bouton "Capture" et l'image apparaît, OK.
Je vais à la "feuille 2" je change les données des cellules c8 et d9 (sans enregistrer les modifications)
Je reviens à la "feuille 1" je clic à nouveau sur le bouton "Capture" l'image avec les modifications faites sur la "feuille2" apparaît, OK.

2) " Feuille 1 "Je clic sur le bouton "Capture" et l'image apparaît, OK.
Je vais à la "feuille 2" je change les données des cellules c8 et d9 (j'enregistre les modifications)
Je reviens à la "feuille 1" je clic à nouveau sur le bouton "Capture" et j'ai le message d'erreur suivant:
Erreur d'exécution BASIC.
Une exception s'est produite :
Type: com.sun.star.lang.IndexOutOfBoundsException
Message: Index (1) needs to be a positive integer smaller than the shape count (1)! at C:/cygwin64/home/buildslave/source/libo-core/svx/source/unodraw/unopage.cxx:356.
Et cette partie du code est grisée: oForme = oPage.getByIndex(i)

3) " Feuille 1 "Je clic sur le bouton "Capture" et l'image apparaît, OK. Je presse au clavier la touche "supprime" et l'image disparaît, OK.
Je vais à la "feuille 2" je change les données des cellules c8 et d9 (j'enregistre les modifications)
Je reviens à la "feuille 1" je clic à nouveau sur le bouton "Capture" l'image avec les modifications faites sur la "feuille2" apparaît, OK.

Le test #3, correspond à ce que je veux mais j'aurais aimé passer outre la touche Supprime du clavier.

Merçi encore pour tout le travail.


Salutations,

[Dude]

je change les données des cellules c8 et d9

Pourquoi faire puisque l'image est générée depuis la plage :

Code : Tout sélectionner

sPlage = "A1:C5" 'plage sur la feuille d'origine

LibreOffice 7.6.4.1 (X86-64), Window7 et Linux_Ubuntu

Je rappelle que ce qui est proposé est fonctionnel sur les versions stables en cours et pas sur ce qui est obsolète.

[Grande Ourse]

Bonjour Dude,

Pourquoi faire puisque l'image est générée depuis la plage :
Parce que les données à l'intérieur de la plage A1:C5 ne sont pas fixes et varient en fonction de l'inventaire, donc lorsque les données changent, je dois enregistrer ces changements.
Présentement, je suis sur la version 24.8.2.1 de LibreOffice.

Avec la touche supprime du clavier pour effacer l'image temporaire, je peux passer en résolu.


Merçi milles fois.

[OOo - Ekel]

Bonjour,

Pour passer en Résolu... il suffit de voir dans ma signature la procédure.

Il manque en effet un élément important.

Cordialement.

[Dude]

On dirait que tu ne lis rien de ce qu'on t'écrit.

sur les versions stables en cours

Présentement, je suis sur la version 24.8.2.1 de LibreOffice.

D'où as-tu vu que cette version était stable ?


Pour rappel, Windows 7 n'est plus maintenu par Microsoft et tu n'as pas indiqué la version de Linux Ubuntu utilisée.