[Résolu][Calc] bouton surlignage ligne

Discussions et questions sur tout ce qui concerne la programmation tous langages et tous modules confondus.

Modérateur : Vilains modOOs

Règles du forum
:alerte: Balisage obligatoire dans cette section !
Aidez-nous à vous aider au mieux en balisant correctement votre question : reportez-vous sur les règles de cette section avant de poster !
fneck
Membre OOrganisé
Membre OOrganisé
Messages : 50
Inscription : 07 janv. 2014 11:38

[Résolu][Calc] bouton surlignage ligne

Message par fneck »

Bonjour,

Je cherche à améliorer le code existant ci-dessous (affecté à des boutons de couleur différentes) selon 3 critères SVP :

Code : Tout sélectionner

Option Explicit


Sub Changer_Couleur(oEvt)
Dim MaCellule as Object, MaCouleur as Long, MaLigne as Long, MaColonne as Long, MaFeuille as Object, I as Integer
	MaFeuille = ThisComponent.Sheets(8) 'classeur avec 8 feuilles, boutons sur la dernière feuille
	MaCellule = ThisComponent.CurrentSelection
	MaLigne = MaCellule.CellAddress.Row
	MaColonne = MaCellule.CellAddress.Column
	MaCouleur = oEvt.Source.Model.BackGroundColor		' couleur passée par la couleur du bouton
	If MaCellule.SupportsService("com.sun.star.table.Cell") Then 			' 1 cellule unique est sélectionnée
    MaFeuille.getCellRangeByPosition(MaColonne, MaLigne, MaColonne+6, MaLigne).CellBackColor = MaCouleur
   
		
	End If
End Sub
Il fonctionne bien en appliquant la couleur de fond du bouton de A à G inclus sur la ligne où se situe le pointeur.
Mais ça ne fonctionne qu'en sélectionnant la 1ère colonne, autrement, il applique la couleur sur 7 colonnes à compter de la position du pointeur.
En plus, j'aimerais que cela fonctionne aussi en sélectionnant plusieurs lignes différentes, contigues ou non.
Enfin, ça ne reproduit "que" la couleur du fond du bouton sans distinction de la couleur de police qui reste noire.
Je précise que compte tenu du nombre de lignes, je ne souhaite pas passer par la mise en forme conditionnelle, et que je suis assez Noob sur les macros .
J'ai donc du mal à adapter des macros que je trouverai dans suprême de codes et consorts.
Je vous Remercie vraiment du temps que vous me consacrez.
Dernière modification par fneck le 25 juin 2019 10:23, modifié 2 fois.
Obligation de version libreoffice 6.2.7.1
windows 10 Pro
Avatar de l’utilisateur
Hubert Lambert
SuppOOrter
SuppOOrter
Messages : 1214
Inscription : 06 avr. 2016 09:26

Re: [Calc] bouton surlignage ligne

Message par Hubert Lambert »

Bonjour,

Voici un petit exemple :

Code : Tout sélectionner

sub change_couleur(event)
    bouton = event.Source.Model
    doc = thiscomponent
    currentselection = doc.CurrentSelection
    currentselection.CellBackColor = bouton.BackgroundColor
    currentselection.CharColor = bouton.TextColor
'    xray bouton
'    xray currentselection
end sub
fneck a écrit :Je précise [...] que je suis assez Noob sur les macros.
Pour gagner du galon, je te conseille vivement d'installer Xray et de décommenter les deux dernières lignes dans la macro ci-dessus. Tu gagneras ainsi beaucoup de temps dans la compréhension des exemples du forum et dans la découverte des objets Uno :wink: .

Cordialement.
Pièces jointes
fneck.ods
(11.96 Kio) Téléchargé 104 fois
AOOo 4.1.7 sur Win10
AOOo 4.1.x sur Linux Mint
LibreOffice 5.x/6.x sur Linux Mint
--
| « Nos défauts devraient nous donner une qualité : l'indulgence pour les défauts des autres » (Rivarol)
fneck
Membre OOrganisé
Membre OOrganisé
Messages : 50
Inscription : 07 janv. 2014 11:38

Re: [Calc] bouton surlignage ligne

Message par fneck »

Je te remercie, j'ai fait ce que tu m'as dit pour XRAY, mais je ne comprends pas toutes ces valeurs et je n'ai pas le temps de m'y impliquer suffisamment cette fois encore
(je suis sur mission et fait ce petit outil en parallèle mais j'arrête à la fin de la semaine et ne sais pas quand je reviendrai).
En bref ton code fonctionne pour ce qui est de la couleur du fond et de police mais ne se porte que dans la cellule où se trouve le curseur alors que j'aimerais qu'il remplisse la ligne de la colonne A à G inclus et ce, quelle que soit la position du curseur sur la ligne.
Je suppose qu'il faut ajouter une boucle de type for next en partant de A mais même ça je ne sais pas le faire.... :aie:

Bon j'avoue j'ai triché et utilisé l'enregistreur, mais à l'aide de ton code et en y joignant l'enregistreur, j'ai tout ce qu'il me fallait(petite difficulté supplémentaire, la colonne commentaire laissée vide la plupart du temps).
fneck.ods
(16.59 Kio) Téléchargé 102 fois
Encore merci du temps consacré :D

Code : Tout sélectionner

sub changer_couleur(event)
	rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoLeftToStartOfDataSel", "", 0, args1())

rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "By"
args2(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoLeftToStartOfDataSel", "", 0, args2())'Butée Gauche


	bouton = event.Source.Model
	doc = thiscomponent
	currentselection = doc.CurrentSelection
	currentselection.CellBackColor = bouton.BackgroundColor
	currentselection.CharColor = bouton.TextColor
'	xray bouton
'	xray currentselection
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "By"
args3(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightToEndOfDataSel", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "By"
args4(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args4())'Butée Droite
bouton = event.Source.Model
	doc = thiscomponent
	currentselection = doc.CurrentSelection
	currentselection.CellBackColor = bouton.BackgroundColor
	currentselection.CharColor = bouton.TextColor
'	xray bouton
'	xray currentselection
end sub
Obligation de version libreoffice 6.2.7.1
windows 10 Pro
Répondre