[Résolu][Calc] Mise en surbrillance ligne et colonne d'une cellule active

[fabiencan]

Bonsoir à tous,

Pour faire simple je souhaite mettre en surbrillance les bordures inférieures et de droite d'une cellule active comme dans le document en pièces jointes (version excel en VBA) mais en version API de LibreOffice Calc.

Merci de vos réponses

Bien à vous

[Dolev]

Bonjour

Le VBA ça ne fonctionnera pas

Faîtes une recherche la prochaine fois car le problème à déjà été posté viewtopic.php?t=53550

[fabiencan]

Bonjour,

Je sais que le VBA ne fonctionnera pas, c'est pour ça que je demande s'il y a une équivalence en API pour éviter les conflits entre les différents logiciels et les différentes les versions.

J'ai déjà fait des recherches, mais cela ne correspond pas à ce que je souhaite. Je ne veux pas que les cellules passent en surbrillance, mais juste les bordures comment en exemple en pièce jointe (qui est malheureusement en version VBA).

Merci

[Dolev]

Je ne veux pas que les cellules passent en surbrillance, mais juste les bordures comment en exemple en pièce jointe (qui est malheureusement en version VBA).

Et bien il suffit d'adapter pour que ce soit les bordures et non la couleur de cellule

La prochaine fois, merci d'indiquer les posts que vous avez déjà trouvés afin de gagner du temps

[jeanmimi]

Bonjour,
Avec ma configuration, ta Macro fonctionne et interprète le code de cette manière :

Macro mise en évidence cellule.png

Le clic sur une autre cellule déplace les lignes rouges là où est le curseur.

[Jurassic Pork]

Hello,
voici une version sans code VBA
Les lignes existent déjà dans la feuille (CurseurH et CurseurV). Le code peut être sûrement durci et optimisé :

Code : Tout sélectionner

Option Explicit

Function Intersection(oEvt as Object) as Boolean
Dim oDoc as Object, maFeuille as Object
Dim oPlage As Object, oCell As Object, oDrawpage, oResult As Object
Dim adrCol as Object, adrRow as Object, oRanges as Object, oLast as Object, oLastPos As Object
Dim oShape As Object, oCurseurH As Object, oCurseurV As Object, oPos As Object, oSize As Object
Dim x As Integer
Const maPlage = "A1:Z26"
    On Error Resume Next
	oDoc = thisComponent
	maFeuille = oDoc.CurrentController.ActiveSheet
	oLast = maFeuille.getCellRangeByName("AA27")
	oLastPos = oLast.Position
	oDrawPage = maFeuille.getDrawPage()
	oPlage  =  maFeuille.getCellRangeByName(maPlage)
	oResult = oEvt.queryIntersection(oPlage.RangeAddress)
	If oResult.RangeAddressesAsString <> "" Then
	     for x = 0 to oDrawPage.Count -1
   			 oShape = oDrawPage.getByIndex(x)
              If oShape.Name = "curseurH" Then
                   oShape.Visible = True 
             	   oPos = oShape.Position
             	   oSize = oShape.Size
             	   oSize.Width = oLastPos.Width: oSize.Height = 10
             	   oPos.X = 0: oPos.Y = oEvt.Position.Y + oEvt.Size.Height
             	   oShape.setPosition(oPos)
             	   oShape.setSize(oSize)
             End If
             If oShape.Name = "curseurV" Then
                oShape.Visible = True
                oPos = oShape.Position
             	oPos.X =  oEvt.Position.X  : oPos.Y = 0
             	oSize = oShape.Size
             	oSize.Width = 10: oSize.Height = oLastPos.Y
             	oShape.setPosition(oPos)
             	oShape.setSize(oSize)
            End If           
        Next x
	Else
	           for x = 0 to oDrawPage.Count -1
   		      	 oShape = oDrawPage.getByIndex(x)
               If oShape.Name = "curseurH" Then
                 oShape.Visible = False
               End If
               If oShape.Name = "curseurV" Then
                 oShape.Visible = False
               End If           
             Next x
         
	End If
End Function

LignesHorVert.gif

Ami calmant, J.P

[fabiencan]

Bonsoir JP,

Merci de ta réponse, c'est tout à fait ce que je recherche.

Petit problème, je n'y connais pas grand-chose en macro...

J'arrive à copier le code dans le catalogue d'objet, j'assigne le macro à la sélection modifiée de ma feuille, mais après rien ne se passe... Même si je ferme et que j'ouvre le fichier en activant les macros...

Et, est-il possible de modifier la couleur de la surbrillance ?

Merci d'avance

[Jurassic Pork]

Hello

J'arrive à copier le code dans le catalogue d'objet, j'assigne le macro à la sélection modifiée de ma feuille, mais après rien ne se passe... Même si je ferme et que j'ouvre le fichier en activant les macros...

il faut affecter la macro à l'événement de feuille Sélection Modifiée -> Menu Feuille/Evénéments de la feuille

SelectModEvt.png

As -tu bien mis deux objets graphiques lignes dans la feuille ?
Met ton classeur en pièce jointe si cela ne fonctionne pas.

Et, est-il possible de modifier la couleur de la surbrillance ?

C'est à dire la couleur des lignes ? dans ce cas il faut changer la couleur des objets graphiques lignes de la feuille (curseurH et curseurV)

Ami calmant, J.P

[fabiencan]

Oui oui c'est ce que j'ai fait, mais rien...

Pour la couleur, changer le rouge en une autre, mais je ne sais pas quelles lignes de code modifier

Désolé pour toutes ces questions

[Jurassic Pork]

Met ton classeur en pièce jointe pour voir (si il n'y a pas de données confidentielles dedans.
Et pour la couleur :

LignesIntersection.png

[EDIT] en code oo Basic exemple pour changer la couleur en vert de la ligne horizontale :

Code : Tout sélectionner

             If oShape.Name = "curseurH" Then
                   oShape.Visible = True 
                   oShape.LineColor = RGB(0, 255, 0)

[fabiencan]

Bonjour,

Je vous mets le classeur avec la macro intégrée.

Super pour les couleurs merci

Merci d'avance

[Jurassic Pork]

Hello,

Oui oui c'est ce que j'ai fait, mais rien...

c'est normal que cela ne fonctionne pas dans ton classeur, il n' y a pas d'objets ligne dans ton classeur
Voici une version de code qui crée les objets lignes si ils n'existent pas :

Code : Tout sélectionner

Option Explicit
Global curseurH As Object
Global curseurV As Object
Sub InitCurseurs()
    Dim oDoc as Object, maFeuille as Object, oDrawPage As Object, oShape As Object
    Dim oPos As Object, oSize As Object, x As Integer
   	oDoc = thisComponent
	maFeuille = oDoc.CurrentController.ActiveSheet
	oDrawPage = maFeuille.getDrawPage()
	For x = 0 to oDrawPage.Count -1
   			 oShape = oDrawPage.getByIndex(x)
              If oShape.Name = "curseurH" Then
                 curseurH = oShape
             End If
             If oShape.Name = "curseurV" Then
                 curseurV = oShape
            End If           
     Next x
     if curseurH is Nothing then
         curseurH = oDoc.createInstance("com.sun.star.drawing.LineShape")
         curseurH.Name = "curseurH"
         oPos = curseurH.Position
         oSize = curseurH.Size
         oPos.X=0: oPos.Y=0: oSize.Width= 1000: oSize.Height=10
         curseurH.LineColor = RGB(255, 0, 0)
         curseurH.setPosition(oPos):curseurH.setSize(oSize)
         curseurH.visible = True
         oDrawPage.Add(curseurH)
     End If
      if curseurV is Nothing then
         curseurV = oDoc.createInstance("com.sun.star.drawing.LineShape")
         curseurV.Name = "curseurV"
         oPos = curseurV.Position
         oSize = curseurV.Size
         oPos.X=0: oPos.Y=0: oSize.Width= 10: oSize.Height=1000
         curseurV.LineColor = RGB(255, 0, 0)
         curseurV.setPosition(oPos):curseurV.setSize(oSize)
         curseurV.visible = True
         oDrawPage.Add(curseurV)
     End If
End Sub


Function Intersection(oEvt) as Boolean
Dim oDoc as Object, maFeuille as Object
Dim oPlage As Object, oCell As Object, oDrawpage, oResult As Object
Dim adrCol as Object, adrRow as Object, oRanges as Object, oLast as Object, oLastPos As Object
Dim oShape As Object, oCurseurH As Object, oCurseurV As Object
Dim oPos As New com.sun.star.awt.Point
Dim oSize  As New com.sun.star.awt.Size
Dim x As Integer
Const maPlage = "A1:Z26"
   ' On Error Resume Next
    InitCurseurs()
	oDoc = thisComponent
	maFeuille = oDoc.CurrentController.ActiveSheet
	oLast = maFeuille.getCellRangeByName("AA27")
	oLastPos = oLast.Position
	oDrawPage = maFeuille.getDrawPage()
	oPlage  =  maFeuille.getCellRangeByName(maPlage)
	oResult = oEvt.queryIntersection(oPlage.RangeAddress)
	If oResult.RangeAddressesAsString <> "" Then
              curseurH.Visible = True 
              oSize.Width = oLastPos.X: oSize.Height = 10
              oPos.X = 0: oPos.Y = oEvt.Position.Y + oEvt.Size.Height
              curseurH.setPosition(oPos)
              curseurH.setSize(oSize)
              curseurV.Visible = True
              oPos.X =  oEvt.Position.X  : oPos.Y = 0
              oSize.Width = 10: oSize.Height = oLastPos.Y
              curseurV.setPosition(oPos)
              curseurV.setSize(oSize)
	Else
              curseurH.Visible = False
              curseurV.Visible = False
	End If
End Function

Le souci que j'ai c'est que j'avais prévu de n'appeler la procédure InitCurseurs qu'une seule fois sur l'événement d'activation de la feuille à l'ouverture du document mais apparemment il n' y a pas cet événement à l'ouverture du document (L.O 7.3.6.2) mais quand par exemple on change de feuille et on revient sur la feuille. En attendant mieux j'ai mis InitCurseurs au début de la fonction Intersection.

Ami calmant, J.P

[fabiencan]

Bonjour JP

Bon, on avance.

Avec le nouveau code, on aperçoit une croix rouge en haut à gauche, mais quand je clique sur une autre cellule rien ne bouge.

Je suis vraiment désolé, je n'y connais rien en macro...

[Jurassic Pork]

Avec le nouveau code, on aperçoit une croix rouge en haut à gauche, mais quand je clique sur une autre cellule rien ne bouge.

C'est normal que cela ne fonctionne pas il faut "brancher" l'événement de changement de sélection sur Intersection pas sur InitCurseurs.

[fabiencan]

Autant pour moi.... je teste et je vous dis si tout fonctionne

Merci

[fabiencan]

C'est parfait tout fonctionne

Encore merci pour tout JP

[fabiencan]

J'ai parlé un peu trop vite, si j'ai le malheur de cliquer sur la ligne qui est en surbrillance le fichier bug et j'ai un message d'erreur sur une ligne de code.

Vu que c'est un fichier où l'on va être plusieurs à travailler, j'ai bien peur qu'ils me le fassent bugger à chaque fois ...

Code : Tout sélectionner

oResult = oEvt.queryIntersection(oPlage.RangeAddress)

[Jurassic Pork]

Hello,

J'ai parlé un peu trop vite, si j'ai le malheur de cliquer sur la ligne qui est en surbrillance le fichier bug et j'ai un message d'erreur sur une ligne de code.

comme indiqué précédemment mon code n'est pas "durci". Au début de la fonction Intersection il faut tester si l'objet déclencheur est bien une cellule (dans ton cas d'erreur c'est une "shape"). Voici le code à placer avant InitCurseurs() dans le code de la fonction Intersection :

Code : Tout sélectionner

    If oEvt.ImplementationName  <> "ScCellObj" then Exit Function

Ami calmant, J.P

[fabiencan]

Bonjour à tous,

Je viens de tester et avec cette ligne de code en plus, j’ai l'impression que tout fonctionne correctement.

Dernière question et je vous laisse tranquille, je n'arrive pas à assigner la macro à plusieurs feuilles... Est-ce que je dois créer autant de macros que j'ai des pages ?

Bon samedi à tous

[Bidouille]

Bonjour,

Je viens de tester et avec cette ligne de code en plus, j’ai l'impression que tout fonctionne correctement.

Donc vous clôturez comme c'est l'usage.

Dernière question

Merci de respecter les règles de ce forum : un fil = un problème

[fabiencan]

Désolé

Je vais ouvrir un autre fil...