Salvar e restaurar valores personalizados de forma programática com VBA

Ao usar o modo Save defined cell values only (salvar apenas valores de célula definidos), o XLS Padlock permite que você salve e restaure valores personalizados, além dos valores de célula predefinidos. Isso é útil para salvar variáveis, configurações ou dados que não são armazenados diretamente em uma célula.

Visão geral

Essa funcionalidade depende de dois eventos VBA e de duas funções da API VBA. Você coloca o código nas sub-rotinas de evento para ler ou gravar seus dados personalizados quando o usuário carrega ou salva o trabalho.

Eventos e funções principais

Eventos VBA

As duas sub-rotinas de evento a seguir devem ser colocadas em um módulo da sua planilha do Excel. O XLS Padlock vai chamá-las automaticamente durante o processo de salvar/carregar.

' 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

Funções da API VBA

WriteCustomCellValue(UniqueID, Value): grava um único valor de cadeia (string) associado a um ID exclusivo.
ReadCustomCellValue(UniqueID, DefaultValue): lê um único valor de cadeia para um determinado ID. Se o ID não for encontrado, retorna o DefaultValue.

Leitura e gravação de valores individuais

Veja como gravar um único valor:

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

E veja como lê-lo de volta:

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

Leitura de todos os valores como um dicionário

Você também pode ler todos os valores personalizados salvos de uma vez, passando uma cadeia vazia como ID para ReadCustomCellValue. Isso retorna um 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

Exemplo completo: salvar/restaurar uma coluna

Esta função auxiliar gera uma cadeia separada por vírgulas a partir dos valores de um determinado intervalo de células.

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 é chamado quando o usuário salva o trabalho. Ele usa a função auxiliar para converter todo o intervalo usado da Coluna A em uma única cadeia e a salva.

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 é chamado quando o usuário carrega um arquivo salvo. Ele lê a cadeia e restaura os valores de volta na Coluna 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 também

- [Como migrar dados de usuário de uma versão anterior](excel-vba-migrate-user-data-updates)

Proteger

Licenciar e vender

Distribuir