Guardar y restaurar valores personalizados mediante programación con VBA

Al usar el modo Save defined cell values only, XLS Padlock le permite guardar y restaurar valores personalizados además de los valores de celda predefinidos. Esto resulta útil para guardar variables, ajustes o datos que no se almacenan directamente en una celda.

Resumen

Esta funcionalidad se basa en dos eventos de VBA y dos funciones de la API de VBA. Coloque el código en las subrutinas de evento para leer o escribir sus datos personalizados cuando el usuario cargue o guarde su trabajo.

Eventos y funciones principales

Eventos de VBA

Las dos subrutinas de evento siguientes deben colocarse en un módulo de su libro de Excel. XLS Padlock las llamará automáticamente durante el proceso de guardado/carga.

' Called when a user loads a save file.
Sub XLSPadlock_RestoreCustomValues()
    ' Your code to read values goes here.
    MsgBox ("Restoring custom values...")
End Sub

' Called when a user saves their work.
Sub XLSPadlock_SaveCustomValues()
    ' Your code to write values goes here.
    MsgBox ("Saving custom values...")
End Sub

Funciones de la API de VBA

WriteCustomCellValue(UniqueID, Value): escribe un único valor de cadena asociado a un ID único.
ReadCustomCellValue(UniqueID, DefaultValue): lee un único valor de cadena para un ID determinado. Si no se encuentra el ID, devuelve el DefaultValue.

Lectura y escritura de valores individuales

Así es como escribiría un valor individual:

Sub XLSPadlock_SaveCustomValues()
    Dim XLSPadlock1 As Object
    On Error Resume Next
    Set XLSPadlock1 = Application.COMAddIns("GXLS.GXLSPLock").Object
    XLSPadlock1.WriteCustomCellValue "MySetting", "MyValue"
End Sub

Y así es como lo leería de nuevo:

Sub XLSPadlock_RestoreCustomValues()
    Dim XLSPadlock1 As Object
    On Error Resume Next
    Set XLSPadlock1 = Application.COMAddIns("GXLS.GXLSPLock").Object

    Dim MySettingValue As String
    MySettingValue = XLSPadlock1.ReadCustomCellValue("MySetting", "Default")
End Sub

Lectura de todos los valores como un diccionario

También puede leer todos los valores personalizados guardados a la vez pasando una cadena vacía como ID a ReadCustomCellValue. Esto devuelve un objeto Scripting.Dictionary.

Sub XLSPadlock_RestoreCustomValues()
    Dim XLSPadlock1 As Object
    On Error Resume Next
    Set XLSPadlock1 = Application.COMAddIns("GXLS.GXLSPLock").Object

    Dim Dict As Object ' Scripting.Dictionary
    Set Dict = XLSPadlock1.ReadCustomCellValue("", "")

    If Not Dict Is Nothing Then
        For Each Key In Dict.Keys
            MsgBox "Key: " & Key & ", Value: " & Dict(Key)
        Next Key
    End If
End Sub

Ejemplo completo: guardar/restaurar una columna

Esta función auxiliar genera una cadena separada por comas a partir de los valores de un rango de celdas determinado.

Function CsvRange(myRange As Range) As String
    Dim csvRangeOutput As String
    Dim entry As Variant
    For Each entry In myRange
        If Not IsEmpty(entry.Value) Then
            csvRangeOutput = csvRangeOutput & entry.Value & ","
        End If
    Next
    If Len(csvRangeOutput) > 0 Then
        CsvRange = Left(csvRangeOutput, Len(csvRangeOutput) - 1)
    End If
End Function

Este evento se llama cuando el usuario guarda su trabajo. Utiliza la función auxiliar para convertir todo el rango usado de la columna A en una única cadena y la guarda.

Sub XLSPadlock_SaveCustomValues()
    Dim XLSPadlock1 As Object
    On Error Resume Next
    Set XLSPadlock1 = Application.COMAddIns("GXLS.GXLSPLock").Object

    Dim rng As Range
    Set rng = ThisWorkbook.Worksheets(2).Range("A1").CurrentRegion

    Dim myString As String
    myString = CsvRange(rng)

    XLSPadlock1.WriteCustomCellValue "MyEntireColumnA", myString
End Sub

Este evento se llama cuando el usuario carga un archivo guardado. Lee la cadena y restaura los valores de nuevo en la columna A.

Sub XLSPadlock_RestoreCustomValues()
    Dim XLSPadlock1 As Object
    On Error Resume Next
    Set XLSPadlock1 = Application.COMAddIns("GXLS.GXLSPLock").Object

    Dim Val As String
    Val = XLSPadlock1.ReadCustomCellValue("MyEntireColumnA", "")

    If Val <> "" Then
        Dim r As Range, i As Long, ar
        Set r = ThisWorkbook.Worksheets(2).Range("A:A")
        r.ClearContents

        ar = Split(Val, ",")
        For i = 0 To UBound(ar)
         r.Cells(i + 1, 1).Value = ar(i)
        Next
    End If
End Sub

## Consulte también

- [Cómo migrar los datos de usuario de una versión anterior](excel-vba-migrate-user-data-updates)

Proteger

Licencia & Venta

Distribuir