Сохранение значений в скрытых именах книги Excel
- Макросы VBA Excel
- Работа с диапазонами ячеек и листами
- Разное
- Формулы Excel
- Книги Excel
- текстовые строки
- Разное
|
Данные функции могут быть полезны, если вы хотите спрятать некоторые значения в книге 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
|