Сохранение информации в пользовательских свойствах книги Excel

Sub ПримерИспользованияПользовательскихСвойствКнигиExcel()
    DDocALL ActiveWorkbook    ' удаляем все ранее назначенные пользовательские свойства
    ' и записываем новые:
    SDoc ActiveWorkbook, "ICQ", "58-36-318"
    SDoc ActiveWorkbook, "Skype", "ExcelVBA.ru"
    SDoc ActiveWorkbook, "Сайт", "http://ExcelVBA.ru/"
 
    ' теперь можно закрыть файл, предварительно его сохранив
    ' а потом, после очередного открытия, считать сохранённые свойства:

    txt = GDoc(ActiveWorkbook, "ICQ") & vbNewLine & GDoc(ActiveWorkbook, "Сайт")
    MsgBox txt, vbInformation, "Пользовательские свойства книги Excel"
    ' и удалить ненужные
    DDoc ActiveWorkbook, "ICQ"
End Sub

Sub SDoc(ByRef WB As Workbook, ByVal VarName As String, ByVal VarValue As Variant)
    ' сохранение пользовательского свойства в книге Excel
    DDoc WB, VarName    ' удаляем свойство, если оно уже есть
    ' и создаём новое с нужным значением
    WB.CustomDocumentProperties.Add VarName, False, msoPropertyTypeString, CStr(VarValue)
End Sub
 
Sub DDoc(ByRef WB As Workbook, ByVal VarName As String)
    ' удаление пользовательского свойства из книги Excel
    If WB.CustomDocumentProperties.Count > 0 Then    ' если они вообще есть
        For Each cdp In WB.CustomDocumentProperties    ' перебираем все свойства
            If cdp.Name = VarName Then cdp.Delete: Exit Sub    ' удаляем
        Next
    End If
End Sub
 
Sub DDocALL(ByRef WB As Workbook)
    ' удаление ВСЕХ пользовательских свойств из книги Excel
    If WB.CustomDocumentProperties.Count > 0 Then
        For Each cdp In WB.CustomDocumentProperties
            cdp.Delete    ' удаляем очередное свойство
        Next
    End If
End Sub
 
Function GDoc(ByRef WB As Workbook, ByVal VarName As String) As String
    ' чтение переменной из книги Excel
    ' функция возвращает значение пользовательского свойства VarName
    ' (если нужное пользовательское свойство отсутствует, возвращает пустую строку)
    If WB.CustomDocumentProperties.Count > 0 Then
        For Each cdp In WB.CustomDocumentProperties
            If cdp.Name = VarName Then GDoc = cdp.Value
        Next
    End If
End Function
 
Function GDocB(ByRef WB As Workbook, ByVal VarName As String) As Boolean
    ' чтение переменной из книги Excel
    ' функция возвращает ПРЕОБРАЗОВАННОЕ К ТИПУ BOOLEAN значение пользовательского свойства VarName
    ' (если нужное пользовательское свойство отсутствует, возвращает FALSE)
    On Error Resume Next
    If WB.CustomDocumentProperties.Count > 0 Then
        For Each cdp In WB.CustomDocumentProperties
            If cdp.Name = VarName Then GDocB = CBool(cdp.Value)
        Next
    End If
End Function

Sub Show_CustomDocumentProperties()
    ' выводит список всех пользовательских свойств в книге, из которой запускается макрос
    If ThisWorkbook.CustomDocumentProperties.count > 0 Then
        For Each cdp In ThisWorkbook.CustomDocumentProperties
            txt = txt & cdp.Name & ":" & vbTab & cdp.Value & vbNewLine
        Next
        MsgBox txt, vbInformation, "Список пользовательских свойств в книге"
    End If
End Sub