Page 1 sur 1

[Résolu][Calc] bouton surlignage ligne

MessagePublié: 24 Juin 2019 16:06
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   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.

Re: [Calc] bouton surlignage ligne

MessagePublié: 24 Juin 2019 20:48
par Hubert Lambert
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.

Re: [Calc] bouton surlignage ligne

MessagePublié: 25 Juin 2019 08:55
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é 24 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