La procedura CheckSign_Set:
- Trasforma la prima cella di rRange in una check box
- Applica il segno di spunta se bValue è TRUE
- Il parametro Style determina lo stile della chekbox
La funzione CheckSign_Get restituisce True se individua un segno di spunta valido
La funzione CheckSign_Switch inverte lo stato della spunta, restituisce true se individua una spunta nella prima cella di rRange
La funzione getSign determina il caratte da unsare in base a valore e stile.
ENG:
The procedure CheckSign_Set:
- Transform the first cell of rrange in a check box
- Draws the check mark if bValue is TRUE
- The Style parameter determines the style of chekbox
The CheckSign_Get function returns True if detects a valid check mark
The CheckSign_Switch function reverses the state of the check, it returns true if finds a tick in the first cell of rrange
The function determines the getSign char to use based on value and style
'
'
' Determina il carattere da usare per il segno di
' Determines the font to use for the sign
Private Function GetSign(bValue As Boolean, Optional style As String = "X") As String
' Stili validi sono: - Valid Styles are:
' X =ý 'Quadretto Crocetta - Square box with cross sign
' V =þ 'Quadretto Spunta - Square box with check sign
' x =û 'Solo Crocetta - cross sign without box
' v =ü 'Solo Spunta - check sign without box
' =¨ 'Quadratto vuoto - Empty box
Dim i As Integer
GetSign = ""
i = InStr("XVxv", style): If i = 0 Then i = 1
If bValue Then
GetSign = Mid$("ýþûü", i, 1)
Else
GetSign = Mid$("¨¨ ", i, 1)
End If
End Function
'
' Imposta il segno di spunta in una cella
' Sets check mark in a cell
'
Sub CheckSign_Set(rRange As Range, bValue As Boolean, Optional Style As String = "X")
Dim c0 As String * 1, c1 As String * 1
With rRange.Cells(1, 1)
.Value = GetSign(bvalu, style)
.Font.Name = "Wingdings"
End With
End Sub
'
' Legge il segno di spunta dalla prima cella di rRange
' Read Check Mark in the first cell of rRange
'
Function CheckSign_Get(rRange As Range) As Boolean
With rRange.Cells(1, 1) ' Legge solo la prima cella; Read only first cell;
If .Font.Name = "Wingdings" Then ' Solo se il font è Wingding; Only for Wingding font;
CheckSign_Get = (InStr("ýþûü", .Value) > 0)
End If
End With
End Function
'
' Inverte il segno di spunta
' Reverses the checkmark
'
Function CheckSign_Switch(rRange As Range, Optional style As String = "X") As Boolean
With rRange.Cells(1, 1)
If .Font.Name = "Wingdings" Then
' If .value is empty add a space
Select Case InStr("ýþûü¨ ", .Value & IIf(Len(.Value) = 0, " ", ""))
Case 1, 2 ' Boxed
.Value = "¨"
Case 3, 4 ' Unboxed
.Value = " "
Case 5, 6 ' Not checke, use style
.Value = GetSign(True, style)
End Select
CheckSign_Switch = True ' Checkbox changed
End If
End With
End Sub
' ITA:
' Aggiungere questo codice nella dichiarazione del foglio di lavoro,
' se si desidera modificare lo stato della casella con un doppio clic.
'
' END:
' Add this code in worksheet declaration, if you want to change the status
' of check box with a double click.
'
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Font.Name = "Wingdings" Then
Cancel = CheckSign_Switch(Target, "X")
End If
End Sub
