Como agregar una casilla de verificación (CheckBox) a una cinta de opciones personalizadas



Código XML:

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
  <ribbon>
    <tabs>
      <!--- Creamos la cinta personalizada -->
      <tab id="MiCinta" label="Mi Cinta">
     <!--- Creamos un grupo -->
        <group id="Grupo01" label="Grupo 01">
          <!--- Creamos un control CheckBox -->
          <checkBox 
            id="CheckBox01" 
            label="CheckBox 01"
            onAction="MacroCheckBox01"
            getPressed="GetPressedCheckbox" 
            tag="ValorPorDefecto:=1" 
            getVisible="GetVisible" 
            getEnabled="GetEnabled"
          />
          <!--- Creamos un control button para consultar -->
          <!--- el estado del control CheckBox -->
          <button 
            id="Boton01"
            label="Consultar Estado"
            imageMso="FormControlCheckBox"
            size = "large"
            onAction="MacroConsultarEstadoCheckBox"
          />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

Código VBA:

Public bCheckBox01 As Boolean   'Estado de la casilla de verificación
                                
'Macro que se ejecuta al modificar el valor del control CheckBox01.
Sub MacroCheckBox01(control As IRibbonControl, bPresionado As Boolean)
    If bPresionado Then
        bCheckBox01 = True
    Else
        bCheckBox01 = False
    End If

    MsgBox "El valor de la casilla de verificación """ & control.ID & """ es: " & bPresionado
End Sub

'Macro que se ejecuta al cargarse el control CheckBox01
Sub GetPressedCheckBox(control As IRibbonControl, ByRef bReturn)
    'Devolución de llamada para el control CheckBox01
    'indica cómo se muestra el control

    Select Case control.ID
        Case Else
            'Si el valor por defecto es igual a 1 el valor del CheckBox
            'al cargarse el control será verdadero, y si es 0 será falso.
            If getTheValue(control.Tag, "ValorPorDefecto") = "0" Then
                bReturn = True
            Else
                bReturn = False
            End If
    End Select
End Sub

Public Sub GetEnabled(control As IRibbonControl, ByRef enabled)
    'To set the property "enabled" to a Ribbon Control
    
    Select Case control.ID
        'Case "ID_XMLRibbControl"
        '    enabled = bolEnabled
        Case Else
            enabled = True
    End Select
End Sub

Public Sub GetVisible(control As IRibbonControl, ByRef visible)
    'To set the property "visible" to a Ribbon Control

    Select Case control.ID
        'Case "ID_XMLRibbControl"
        '    visible = bolVisible
        Case Else
            visible = True
    End Select
End Sub

Public Function getTheValue(strTag As String, strValue As String) As String
    ' *************************************************************
    ' Erstellt von     : Avenius
    ' Parameter        : Input String, SuchValue String
    ' Erstellungsdatum : 05.01.2008
    ' Bemerkungen      :
    ' Änderungen       :
    '
    ' Beispiel
    ' getTheValue("DefaultValue:=Test;Enabled:=0;Visible:=1", "DefaultValue")
    ' Return           : "Test"
    ' *************************************************************
      
    On Error Resume Next
      
    Dim workTb()     As String
    Dim Ele()        As String
    Dim myVariabs()  As String
    Dim i            As Integer

    workTb = Split(strTag, ";")
      
    ReDim myVariabs(LBound(workTb) To UBound(workTb), 0 To 1)
    For i = LBound(workTb) To UBound(workTb)
        Ele = Split(workTb(i), ":=")
        myVariabs(i, 0) = Ele(0)
        If UBound(Ele) = 1 Then
            myVariabs(i, 1) = Ele(1)
        End If
    Next
      
    For i = LBound(myVariabs) To UBound(myVariabs)
        If strValue = myVariabs(i, 0) Then
            getTheValue = myVariabs(i, 1)
        End If
    Next
End Function

'Consultar valor del control CheckBox
Sub MacroConsultarEstadoCheckBox(control As IRibbonControl)
    MsgBox "El valor de la casilla de verificación es: " & bCheckBox01
End Sub

Otra forma más sencilla:

Código XML:

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<ribbon>
<tabs>
<!--- Cinta: Gerencia de Administración y Finanzas -->
<tab id="C01_GerAyF" label="Ger. AyF">
<!--- Grupo Administrar -->
<group id="G01_Administrar" label="Administrar">
<!--- Creamos un control CheckBox -->
<checkBox 
id="chkUsarBDServidor" 
label="Usar BD servidor"
onAction="UsarBDServidor"
getPressed="CargarControl_chkUsarBDServidor"
/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>


Código VBA:

'*** INICIO: Administrar control chkUsarBDServidor ***

Public bUsarBDServidor As Boolean   'Estado de la casilla de verificación
                                    'del control ChekBox "Usar BD Servidor"
                                
'Macro que se ejecuta al cargarse el control chkUsarBDServidor
Sub CargarControl_chkUsarBDServidor(control As IRibbonControl, ByRef bReturn)
    If ThisWorkbook.Sheets("AdmXML").Range("bUsarBDServidor") = "VERDADERO" Then
        bReturn = True
    Else
        bReturn = False
    End If
End Sub
                                
'Macro que se ejecuta al modificar el valor del control chkUsarBDServidor
Sub UsarBDServidor(control As IRibbonControl, bPresionado As Boolean)
    If bPresionado Then
        bUsarBDServidor = True
    Else
        bUsarBDServidor = False
    End If

    GuardarValorUsarBDServidor bUsarBDServidor
End Sub

'Guarda el valor de bUsarBDServidor
Sub GuardarValorUsarBDServidor(bValor As Boolean)
    If bValor Then
        ThisWorkbook.Sheets("AdmXML").Range("bUsarBDServidor") = "VERDADERO"
    Else
        ThisWorkbook.Sheets("AdmXML").Range("bUsarBDServidor") = "FALSO"
    End If
    ThisWorkbook.Save
End Sub


'*** FIN: Administrar control chkUsarBDServidor ***


1 comentario: