Сохранение значений в скрытых именах книги Excel

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

Sub ПримерИспользования()
    SaveValue ThisWorkbook, "test", "123qwe"
    Debug.Print GetValue(ThisWorkbook, "test")
End Sub

Private Sub Workbook_Open()
    ActiveSheet.Unprotect GetValue(ThisWorkbook, "пароль")
End Sub

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