Sub FillWorkbookProperties(ByRef wb As Workbook, _
                           Optional ByVal Title As String = vbNullString, Optional ByVal Subject As String = vbNullString, _
                           Optional ByVal Author As String = vbNullString, Optional ByVal Keywords As String = vbNullString, _
                           Optional ByVal Template As String = vbNullString, Optional ByVal LastAuthor As String = vbNullString, _
                           Optional ByVal Manager As String = vbNullString, Optional ByVal Company As String = vbNullString)
    
     
     
    On Error Resume Next
   
 
 
    With wb.BuiltinDocumentProperties
        If Len(Title) Then .Item(1) = Title
        If Len(Subject) Then .Item(2) = Subject
      '  If Len(Author) Then .Item(3) = Author
       ' If Len(Template) Then .Item(4) = Template
       ' .Item(5) = MyComment
      '  If Len(LastAuthor) Then .Item(7) = LastAuthor
        'If Len(Manager) Then .Item(20) = Manager
        If Len(Company) Then .Item(21) = Company
    End With
End Sub



Sub ПримерИспользования_FillWorkbookProperties()
    FillWorkbookProperties ActiveWorkbook, "Test1", , , , , , , Company
End Sub