'Cree par Bigish (Philippe E)
'Le 08/06/2009
'ce code est a mettre dans le code d'une feuille
Option Explicit
Const Marque As String = "\/"
Public Maplage As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'exemple d'utilisation: les cellules de la colonne "B" se transforment en Checkbox
' pour permettre la selection ou deselection de ligne entiere, par simple clic(dans la colonne B)
Call PseudoCheckBox(Target,"B")
End Sub
Sub PseudoCheckBox(ByVal Target As Range, Optional ByVal Colonne As String = "A")
Dim MaCellule As Range, TempPlage As Range
'on verifi que la variable target pointe sur la colonne specifiée et sur une cellule unique
On Local Error Resume Next
If Target.Column = Columns(Colonne).Column And Target.Cells.Count = 1 Then
If Not Err = 0 Then Exit Sub
'on desactive la mise a jour de l'affichage
Application.ScreenUpdating = False
Application.EnableEvents = False
'si la variable target pointe sur une cellule qui contient deja la marque
If Target = Marque Then
'on efface le contenu de la cellule
Target.ClearContents
'on vide la variable MaPlage
Set Maplage = Nothing
'on recuppere toute les cellules qui contiennent du text sur la colonne spécifiée
Set TempPlage = Columns(Colonne).SpecialCells(xlCellTypeConstants, 2)
'on vas verifier si ce text est une marque
For Each MaCellule In TempPlage
If MaCellule.Value = Marque Then 'si c'est une marque
'on reconstruit alors MaPlage
If Maplage Is Nothing Then 'premier passage
'entirerow sert a selectionner toute la ligne de la cellule pointee par MaCellule
Set Maplage = MaCellule.EntireRow
Else 'les autres passages
Set Maplage = Union(Maplage, MaCellule.EntireRow)
End If
End If
Next
On Error Resume Next
Maplage.Select
'si la variable target pointe sur une cellule vide
ElseIf Target.Value = "" Then
With Target
.Value = Marque 'on lui ajoute une marque
'on met en forme la cellule
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'on met en forme la marque
With Target.Characters(Start:=1, Length:=1).Font
.Name = "Arial"
.Size = 7
End With
With Target.Characters(Start:=2, Length:=1).Font
.Name = "Arial"
.FontStyle = "Italic"
.Size = 12
End With
On Error Resume Next
Maplage.Select
Set Maplage = Union(Selection, Rows(Target.Row))
Maplage.Select
End If
'on reactive la mise a jour de l'affichage
Application.ScreenUpdating = True
Application.EnableEvents = True
'si on clic en dehors de la colonne specifiée elle sera vidée de ses marques (Option)
ElseIf Not Target.Column = Columns(Colonne).Column And Target.Cells.Count = 1 Then
'Columns(Colonne).ClearContents
'Set Maplage = Nothing
'Target.Select
End If
End Sub
