Данные функции могут быть полезны, если вы хотите спрятать некоторые значения в книге Excel

Функция SaveValue предназначена для создания (изменения существующих) имён в книге, а функция GetValue - для получения ранее сохранённых значений.

Sub SaveValue(ByRef WB As Workbook, ByVal Parameter As String, ByVal NewValue As String)

    ' создаёт в книге WB скрытое имя Parameter со значением NewValue

    Dim n As Name: On Error Resume Next: Err.Clear

    NewValue = "%%%" & NewValue & "%%%"

    WB.Names(Parameter).RefersTo = NewValue

    If Err Then WB.Names.Add Parameter, NewValue

    WB.Names(Parameter).Visible = False

End Sub

Function GetValue(ByRef WB As Workbook, ByVal Parameter As String) As String

    ' возвращает ранее сохранённое значение в скрытом свойстве книги

    On Error Resume Next

    GetValue = WB.Names(Parameter).RefersTo

    GetValue = Split(GetValue, "%%%")(1)

End Function

Ознакомьтесь также с макросом для просмотра всех имён в книге Excel
(чтобы потом посмотреть результат работы функции SaveValue)

Пример записи и чтения скрытых значений:

Sub ПримерИспользования()

    SaveValue ThisWorkbook, "test", "123qwe"

    Debug.Print GetValue(ThisWorkbook, "test")

End Sub

Использовать данный код можно, например, для программного снятия пароля с листа Excel при открытии книги:

Private Sub Workbook_Open()

    ActiveSheet.Unprotect GetValue(ThisWorkbook, "пароль")

End Sub

Ещё один вариант (для сохранения длинных текстовых строк в скрытых именах листов Excel):

Sub SaveTextWithSheet(ByRef sh As Worksheet, ByVal Parameter As String, ByVal txt As String)

    On Error Resume Next: Dim cnt&, i&, NewValue$: Const MaxLen& = 240, DATA_SEP$ = "~Џ%ћ"

    cnt& = Application.WorksheetFunction.RoundUp(Len(txt) / MaxLen&, 0)

    Err.Clear: sh.Names(Parameter).RefersTo = cnt&

    If Err Then sh.Names.Add Parameter, cnt&, false

    If cnt& = 0 Then Exit Sub

    For i = 1 To cnt&

        NewValue$ = DATA_SEP$ & Mid(txt, (i - 1) * MaxLen& + 1, MaxLen&) & DATA_SEP$

        Err.Clear: sh.Names(Parameter & "_" & Format(i, "0000")).RefersTo = NewValue$

        If Err Then sh.Names.Add Parameter & "_" & Format(i, "0000"), NewValue$, false

    Next

End Sub

Function GetTextFromSheet(ByRef sh As Worksheet, ByVal Parameter As String) As String

    On Error Resume Next: Dim cnt&, i&, NewValue$: Const MaxLen& = 240, DATA_SEP$ = "~Џ%ћ"

    cnt& = Val(Mid(sh.Names(Parameter).RefersTo, 2))

    If cnt& = 0 Then Exit Function

    For i = 1 To cnt&

        NewValue$ = Split(sh.Names(Parameter & "_" & Format(i, "0000")).RefersTo, DATA_SEP$)(1)

        GetTextFromSheet = GetTextFromSheet & NewValue$

    Next

End Function

Sub ПримерИспользования()

    txt$ = "Это очень длинный текст: " & String(100500, "x")

    MsgBox "Длина исходной строки = " & Len(txt$)

    ' сохраняем текст в листе Excel

    SaveTextWithSheet ActiveSheet, "MyText", txt$

    ' извлекаем текст с листа

    res$ = GetTextFromSheet(ActiveSheet, "MyText")

    MsgBox "Длина извлеченной строки = " & Len(res$) & vbNewLine & vbNewLine & res$

End Sub

• 9798 просмотров