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
Nessun commento:
Posta un commento