Attribute VB_Name = "Module1"
Option Explicit

Dim wBook                  As Workbook
Dim MyObj As DocumentProperty
Dim MyVar As Variant
Dim MyCheck As Variant

Sub Excel個人情報一覧()
    
    For Each MyVar In ActiveWorkbook.BuiltinDocumentProperties
        On Error Resume Next
        Err.Clear
        MyCheck = MyVar.Value
        If Not Err.Number = 0 Then
            Debug.Print MyVar.Name & " Err:" & Err.Number & Err.Description
        Else
            Debug.Print MyVar.Name & " --> " & MyVar.Value
        End If
        On Error GoTo 0
    Next
        
End Sub

Sub Excelオートメーションエラーとは()
        
    Set MyObj = ActiveWorkbook.BuiltinDocumentProperties("Last print date")
    On Error Resume Next
    Set MyVar = MyObj.Value
    Debug.Print Err.Number
    Debug.Print Err.Description
    Debug.Print Err.HelpContext
    Debug.Print Err.HelpFile
    Debug.Print Err.LastDllError
    Debug.Print Err.Source
        
End Sub

Sub Excel個人情報エラー除く一覧()
        
    For Each MyVar In ActiveWorkbook.BuiltinDocumentProperties
        On Error Resume Next
        Err.Clear
        MyCheck = MyVar.Value
        If Err.Number = 0 Then
            Debug.Print MyVar.Name & " --> " & MyVar.Value
        End If
        On Error GoTo 0
    Next
        
End Sub

Sub Excel個人情報値セット()
Attribute Excel個人情報値セット.VB_ProcData.VB_Invoke_Func = " \n14"
    
    Set wBook = Application.ActiveWorkbook
    Application.DisplayAlerts = False
    wBook.RemovePersonalInformation = True
    
    For Each MyVar In ActiveWorkbook.BuiltinDocumentProperties
        On Error Resume Next
        Err.Clear
        MyCheck = MyVar.Value
        Set MyObj = MyVar
        If Err.Number = 0 Then
            '
            Err.Clear
            Select Case True
                Case IsDate(MyVar.Value)
                    MyObj.Value = "2099/12/31"
                Case MyObj.Name = "Revision number"
                    MyObj.Value = "9"
                Case MyObj.Name = "Security"
                    MyObj.Value = 9
                Case MyObj.Name = "Author"
                    MyObj.Value = "一時的Author"
                Case MyObj.Name = "Last author"
                    MyObj.Value = "一時的Lastauthor"
                Case MyObj.Name = "Manager"
                    MyObj.Value = "一時的Manager"
                Case MyObj.Name = "Company"
                    MyObj.Value = "一時的Company"
                Case Else
                    MyObj.Value = "ABCDE"
            End Select
            If Err.Number <> 0 Then
                Debug.Print MyObj.Name & " Err:" & Err.Description
            Else
                Debug.Print MyObj.Name & " - " & MyObj.Value
            End If
        End If
        On Error GoTo 0
    Next
    
    '個人情報は保存しないレ点
    ActiveWorkbook.RemovePersonalInformation = True
    Application.DisplayAlerts = True
    Set wBook = Nothing
    Debug.Print "個人情報を変更しました。"
    
End Sub

Sub Excel個人情報値セットの保存()
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = True
End Sub

Sub 個人情報削除()
        
    Set wBook = Application.ActiveWorkbook
    Application.DisplayAlerts = False
    wBook.RemovePersonalInformation = True
    
    For Each MyVar In ActiveWorkbook.BuiltinDocumentProperties
        On Error Resume Next
        Err.Clear
        MyCheck = MyVar.Value
        Set MyObj = MyVar
        If Err.Number = 0 Then
            Err.Clear
            If IsDate(MyObj.Value) Then
                MyObj.Value = "2000/01/01"
            Else
                MyObj.Value = Empty
            End If
            If Err.Number <> 0 Then
                Debug.Print MyObj.Name & " - " & Err.Description
            Else
                Debug.Print MyObj.Name & " - " & MyObj.Value
            End If
        End If
        On Error GoTo 0
    Next
    
    '個人情報は保存しないレ点
    ActiveWorkbook.RemovePersonalInformation = False
    
    Application.DisplayAlerts = True
    Set wBook = Nothing
    Debug.Print "個人情報を削除しました。"

End Sub

Sub Excel個人情報削除セットの保存()
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = True
End Sub