こんにちは。最近タイピングにはまっていて、Word文書の編集時間からタイピング速度を計算するエクセルVBAマクロを作りました。
VBEやユーザーモジュールなどをわかる方を対象にしています。
上にあるような、文書のプロパティにある情報をVBAで活用してみたいと思います。
VBAのポイントは
- Wordファイルを開く
- 文章のプロパティを取得する
Sub type_meter() Range("A1").Value = "Last save time" Range("B1").Value = "File name" Range("C1").Value = "Type per minute" Range("D1").Value = "Number of characters" Range("E1").Value = "Total editing time" Dim file_name As String file_name = Application.GetOpenFilename("Word Document,*.doc?") If file_name = "False" Then Exit Sub End If Dim word As Object Set word = CreateObject("Word.Application") Dim doc As Object Set doc = word.Documents.Open(file_name, ReadOnly:=True) Dim row As Integer row = 1 While Cells(row, 1).Value <> "" row = row + 1 Wend Cells(row, 1).Value = Str(doc.BuiltinDocumentProperties("Last save time")) Cells(row, 2).Value = Dir(file_name) Cells(row, 4).Value = doc.BuiltinDocumentProperties("Number of characters") Cells(row, 5).Value = doc.BuiltinDocumentProperties("Total editing time") Cells(row, 3).Value = Cells(row, 4) / Cells(row, 5) doc.close SaveChanges:=False Set doc = Nothing word.quit SaveChanges:=False Set word = Nothing End Sub
まずGetOpenFilename()でファイル選択画面を表示して、ファイルパスを得ます。
次にCreateObjectでWordを用意して、Openで読み取り専用で開きます。
これで文書プロパティにアクセスできるようになりました。
最後にBuiltinDocumentProperties()に有効な文字列を入れて、プロパティの値を取得します。
ちなみに、Total editing timeの値は、分単位の数値でした。
小ネタとしては
表の次の行を指定するためのループ
Dir()でファイルパスからファイル名を取り出している
最後にオブジェクトの参照をNothingでクリアしている
ぜひ、試してみてください
実行環境
Windows10
Office2013 Professional
参考
- GetOpenFilename http://officetanaka.net/excel/vba/tips/tips154.htm
- BuiltinDocmentProperties http://d.hatena.ne.jp/the-otakky/20120117/1326801714
- Dir http://officetanaka.net/excel/vba/tips/tips78.htm