[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 !

[Résolu][Calc] bouton surlignage ligne

Messagepar fneck » 24 Juin 2019 16:06

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   AgrandirRéduire
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 édition par fneck le 25 Juin 2019 09:23, édité 2 fois.
Obligation de version libreoffice 5.2.6.2
windows 10
fneck
Membre lOOyal
Membre lOOyal
 
Message(s) : 39
Inscrit le : 07 Jan 2014 11:38

Re: [Calc] bouton surlignage ligne

Messagepar Hubert Lambert » 24 Juin 2019 20:48

Bonjour,

Voici un petit exemple :
Code : Tout sélectionner   AgrandirRéduire
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é 16 fois
AOOo 4.1.2 sur Win7
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)
Avatar de l’utilisateur
Hubert Lambert
SuppOOrter
SuppOOrter
 
Message(s) : 1139
Inscrit le : 06 Avr 2016 08:26

Re: [Calc] bouton surlignage ligne

Messagepar fneck » 25 Juin 2019 08:55

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é 14 fois

Encore merci du temps consacré :D
Code : Tout sélectionner   AgrandirRéduire
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 5.2.6.2
windows 10
fneck
Membre lOOyal
Membre lOOyal
 
Message(s) : 39
Inscrit le : 07 Jan 2014 11:38


Retour vers Macros et API

Qui est en ligne ?

Utilisateur(s) parcourant ce forum : Aucun utilisateur inscrit et 1 invité