Aangepaste waarden programmatisch opslaan en herstellen met VBA

In de modus Save defined cell values only kunt u met XLS Padlock naast vooraf gedefinieerde celwaarden ook aangepaste waarden opslaan en herstellen. Dit is handig om variabelen, instellingen of gegevens op te slaan die niet rechtstreeks in een cel zijn opgeslagen.

Overzicht

Deze functionaliteit berust op twee VBA-gebeurtenissen en twee VBA-API-functies. U plaatst code in de gebeurtenis-subroutines om uw aangepaste gegevens te lezen of te schrijven wanneer de gebruiker zijn werk laadt of opslaat.

Belangrijkste gebeurtenissen en functies

VBA-gebeurtenissen

De volgende twee gebeurtenis-subroutines moeten in een module van uw Excel-werkmap worden geplaatst. XLS Padlock roept ze tijdens het opslaan en laden automatisch aan.

' 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

VBA-API-functies

WriteCustomCellValue(UniqueID, Value): Schrijft een enkele tekenreekswaarde die aan een unieke ID is gekoppeld.
ReadCustomCellValue(UniqueID, DefaultValue): Leest een enkele tekenreekswaarde voor een bepaalde ID. Als de ID niet wordt gevonden, geeft de functie de DefaultValue terug.

Afzonderlijke waarden lezen en schrijven

Zo schrijft u een enkele waarde:

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

En zo leest u die weer in:

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

Alle waarden als Dictionary lezen

U kunt ook alle opgeslagen aangepaste waarden in één keer lezen door een lege tekenreeks als ID aan ReadCustomCellValue door te geven. Dit geeft een Scripting.Dictionary-object terug.

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

Volledig voorbeeld: een kolom opslaan/herstellen

Deze hulpfunctie genereert uit de waarden van een bepaald celbereik een door komma’s gescheiden tekenreeks.

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

Deze gebeurtenis wordt aangeroepen wanneer de gebruiker zijn werk opslaat. Ze gebruikt de hulpfunctie om het volledige gebruikte bereik van kolom A om te zetten in één enkele tekenreeks en deze op te slaan.

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

Deze gebeurtenis wordt aangeroepen wanneer de gebruiker een opgeslagen bestand laadt. Ze leest de tekenreeks en herstelt de waarden in kolom 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

## Zie ook

- [Hoe u gebruikersgegevens uit een vorige versie migreert](excel-vba-migrate-user-data-updates)

Beschermen

Licentie & verkoop

Distribueren