Bordure épaisse en encadré de la sélection après clic droit ?

[anthoYS]

Bonjour,

Quel code peut réaliser cela ?​

Merci

 

[job75]

Bonjour anthoYS,

Cela a sûrement été déjà traité :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Byte
Cancel = True
Cells.Borders.LineStyle = xlNone 'RAZ nécessaire
For i = 7 To 10
    Target.Borders(i).Weight = xlThick
Next
End Sub

A+

 

[anthoYS]

Ok merci, dommage qu'il y ai une mise à zéro.

 

[job75]

dommage qu'il y ai une mise à zéro.

Bah vous faites ce que vous voulez, c'est jouable si vous utilisez le clic droit toujours à bon escient.

 

[BOISGONTIER]

Bonsoir,

-Encadre (seulement) la dernière sélection en rouge.
-Ne détruit pas les encadrements existants.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  On Error Resume Next
  ActiveSheet.Shapes("Curseur").Visible = True
  If Err <> 0 Then
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 6, 6, 8, 6).Name = "curseur"
    ActiveSheet.Shapes("Curseur").Fill.Visible = msoFalse
    ActiveSheet.Shapes("curseur").Line.Visible = True
    ActiveSheet.Shapes("curseur").Line.ForeColor.SchemeColor = 10
    ActiveSheet.Shapes("curseur").Line.Weight = 3
  End If
  ActiveSheet.Shapes("curseur").Left = Target.Left
  ActiveSheet.Shapes("curseur").Top = Target.Top
  ActiveSheet.Shapes("curseur").Height = Selection.Height
  ActiveSheet.Shapes("curseur").Width = Selection.Width
  Cancel = True
End Sub

jb

 

[eriiic]

Bonjour à tous,

contour en préservant aussi les encadrements intérieurs :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Target.BorderAround Weight:=xlThick, ColorIndex:=3
End Sub

 

[Si...]

Bon_jour
Pour les bordures extérieures seulement

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, [A2:A6500]) Is Nothing And Target.CountLarge = 1 Then _
         Target.Borders.Weight = xlThick
End Sub

 

[eriiic]

Bonjour si...,
Ca n'est valable que pour une cellule unique ta proposition.
eric

 

[Si...]

Bonjour si...,
Ca n'est valable que pour une cellule unique ta proposition.
eric

Salut eriiic

mais c'est aussi le cas avec les 2 évènements (que j'ai évités pour varier un peu) :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

Pour toucher plusieurs cellules d'une zone nommée Plage on peut passer par

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, [A2:A6500]) Is Nothing Then _
             [Plage].Borders.Weight = xlThick
End Sub

nota : je m'en suis tenu à "encadrer" donc n'ai pas pensé à l'intérieur.

 

[eriiic]

Il me semble que le but étant de faire le contour sans toucher aux bordures intérieures.
Ce que je fais en 1 ligne, ça sera difficile de faire mieux ;-)

 

[anthoYS]

Merci tout le monde!
je suis toujours bloqué.

 

[BOISGONTIER]

Bonjour,

Quel est le pb?

jb

 

[anthoYS]

Bonjour,

@BOISGONTIER,
En fait, ça ne conserve pas la MEF. Si je change avec clic droit, ça va effacer celle en cours Mais je peux garder ça, et là faire manuellement, ainsi elle ne s'efface pas, cette version va mieux que celle de job75.

 

[BOISGONTIER]

>En fait, ça ne conserve pas la MEF.
Le pgm utilise un Shape. Je ne vois pas le rapport avec la MEF.

S'agit-il d'encadrer la sélection en cours ou de faire plusieurs encadrements?

jb

 

[anthoYS]

Oui pardon, par MEF j'entends le cadre noir.