mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

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

К примеру, вам хотелось бы перед отправкой очередного файла (книги) 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

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

О разобрался:) Заменил Workbook на Document.

Кто нибудь может подсказать? Как этот код адаптировать под Word?

Благодарю вас! О записи и чтении пользовательских свойств книги эксель я мечтал давно, да все никак не мог сформулировать :)

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _____   _     _____   ____     __     _   
|___ / | |_ | ___| | __ ) / /_ | |_
|_ \ | __| | |_ | _ \ | '_ \ | __|
___) | | |_ | _| | |_) | | (_) | | |_
|____/ \__| |_| |____/ \___/ \__|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.