mercoledì 23 marzo 2016

Simulare Check Box in una cella : Simulate CheckBox in cell

ITA:
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