【VBA】ドキュメントプロパティを設定する
<機能>
ブックのドキュメントプロパティ(BuiltinDocumentProperties)を設定します
(1)新規ブックにドキュメントプロパティをセット
(2)先頭シートにドキュメントプロパティの内容を出力します
<動作検証&開発環境>
Microsoft Office2016
<実行イメージ>
シートにドキュメントプロパティの内容を出力
<使い方>
適当なところにソースを貼り付けてください
新規ブックにプロパティを設定する() を実行すると処理を開始します
'********************************************
'VBAで新規ブックにプロパティを設定する
'(1)ブックを新規作成
'(2)プロパティを設定
'(3)シートにプロパティの内容を出力して保存
'********************************************
Sub 新規ブックにプロパティを設定する()
Dim strName As String
Dim gyo As Integer
'//ブック名を生成
strName = ThisWorkbook.Path & "¥SAMPLE_" & Replace(Replace(Replace(Now(), "/", ""), " ", ""), ":", "") & ".xlsx"
'//テスト用ブックを新規作成
'//FileFormatにExcelブック(*.xlsx)形式を指定
Workbooks.Add
'//ブックを保存する(ファイル形式に.xlsx:xlOpenXMLWorkbookを指定)
'//XlFileFormat列挙体の設定値についてはOffice DevCenter参照
ActiveWorkbook.SaveAs Filename:=strName, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
'//ブックにプロパティを設定
Workbooks.Open strName
With Workbooks(Mid(strName, InStrRev(strName, "¥") + 1))
'タイトル
.BuiltinDocumentProperties("Title").Value = "ブックにプロパティをセット"
'件名
.BuiltinDocumentProperties("Subject").Value = "プロパティの設定と取得のテスト"
'タグ
.BuiltinDocumentProperties("Keywords").Value = "VBA BuiltinDocumentProperties"
'分類項目
.BuiltinDocumentProperties("Category").Value = "VBAプログラムサンプル"
'コメント
.BuiltinDocumentProperties("Comments").Value = "平成28年12月会議にて使用予定" & vbCrLf & "佐藤部長レビュー済み資料(2016.11.05)"
'作成者
.BuiltinDocumentProperties("Author").Value = "山田 太郎"
'改定番号(整数)
.BuiltinDocumentProperties("Revision Number").Value = "4"
'バージョン番号
.BuiltinDocumentProperties("Document version").Value = "1.0.8"
'会社
.BuiltinDocumentProperties("Company").Value = "株式会社○△□"
'マネージャー
.BuiltinDocumentProperties("Manager").Value = "田中部長"
'コンテンツの作成日時
.BuiltinDocumentProperties("Creation Date").Value = "2016/12/20 10:09"
'//すべてのプロパティを先頭シートに出力する
.Sheets(1).Activate
'//セル幅、フォントを指定
Columns("A:B").Select
Selection.Clear
Selection.ColumnWidth = 30
Selection.RowHeight = 50
Selection.Font.Name = "メイリオ"
Selection.Font.Size = 10
'//折り返して全体を表示
Selection.WrapText = True
'//水平方向左、垂直方向中央揃え
Selection.HorizontalAlignment = xlLeft
Selection.VerticalAlignment = xlCenter
Range("A1").Select
'//エラー処理ルーチンを有効
On Error Resume Next
gyo = 1
For Each p In .BuiltinDocumentProperties
Cells(gyo, 1).Value = p.Name
Cells(gyo, 2).Value = p.Value
gyo = gyo + 1
Next
On Error GoTo 0
'//ブックをクローズ
.Close True
End With
End Sub
よろしければポチッと押してください