徒然日記

徒然なるままに書いていきます 固めのものからゆるい日常まで書きたいものを

Excel VBAで執筆管理ツールを作成した

f:id:cobaltic:20210808122141p:plain
完成イメージはこんな感じです。

本ツールを使って出来ることは以下の通りです。
・ボタンクリックでファイルの開閉
・執筆時間、書いた文字数などの記録
・バックアップファイルの自動作成

実際に今回作成したコードを下記に示します。
環境はWindows10でMicrosoft 365 Personalです。

Sub 執筆開始時マクロ()
' 執筆開始時マクロ Macro

'変数宣言-------------------------
    
    Dim 連番 As Integer
    Dim Filename As String
    Dim 開始字数 As Integer
    Dim wdApp As Word.Application
    
    連番 = Cells(Rows.Count, "A").End(xlUp).Row
    Filename = ThisWorkbook.Sheets(1).Name
    
'変数宣言-------------------------

'シート名のwordを立ち上げる-------

    On Error Resume Next
    
    Set wdApp = CreateObject("Word.Application")
    'wordアプリケーションを立ち上げる(オブジェクト生成しただけ)
    
    wdApp.Visible = True
    'wordを可視化する(前の処理ではオブジェクトとして生成されただけなので、画面上には何も現れてこない)
    
    Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\" & Filename & ".docx")
    'ファイルの立ち上げ(Excelファイルと同じディレクトリにないと立ち上げられない)
    
    Call AppActivate(Filename)
    '立ち上げたwordファイルを最前ウィンドウに持ってきくる
    
'シート名のwordを立ち上げる-------
    
    
'進捗管理シートに各種情報を記入---
    
    開始字数 = wdDoc.Characters.Count
    Cells(連番 + 1, 1).Value = Cells(連番, 1).Value + 1
    Cells(連番 + 1, 2).Value = Date
    Cells(連番 + 1, 3).Value = Time
    Cells(連番 + 1, 6).Value = 開始字数

'進捗管理シートに各種情報を記入---
    
    Set wdDoc = Nothing
    
    End
    
End Sub

主にやっていることはコードをみたままですが、
・同一ディレクトリ内にある、管理シート名のWordファイルを立ち上げ
・連番、日付、開始時間、開始字数をシートに書き込み
という感じです。

基本的にはVisible=Trueは固定にしておいた方がいいです。
最後に Set wdDoc = Nothing としているのは、こうしないとメモリが解放されないからです。

注意点としては、テーブル化すると連番で取得するセルの位置がテーブル範囲内で一番下の行の位置となってしまうので、テーブル化する場合はコードの改変が必要です。

そして、こちらが執筆終了時に使うマクロのコードです。

Sub 執筆終了時マクロ()
' 執筆終了時マクロ Macro

'変数宣言-------------------------
    
    Dim 連番 As Integer
    Dim Filename As String
    Dim 終了字数 As Integer
    Dim wdApp As Word.Application
    Dim doc As Document
    
    連番 = Cells(Rows.Count, "D").End(xlUp).Row
    Filename = ThisWorkbook.Sheets(1).Name 
    
'変数宣言-------------------------
    

'シート名のwordを立ち上げる-------

    Set wdApp = CreateObject("Word.Application")
    'wordアプリケーションを立ち上げる(オブジェクト生成しただけ)
    
    wdApp.Visible = True
    'wordを可視化する(前の処理ではオブジェクトとして生成されただけなので、画面上には何も現れてこない)
    
    Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\" & Filename & ".docx", ReadOnly:=True)
    'ファイルの立ち上げ(Excelファイルと同じディレクトリにないと立ち上げられない)

'シート名のwordを立ち上げる-------
    

'バックアップファイルの作成-------
       
    With wdDoc
    終了字数 = .Characters.Count
    .SaveAs2 Filename:=ThisWorkbook.Path & "\" & Filename & "_バックアップ" & "\" & Filename & "_v" & 連番
    'このWorkbookのpathの下階層にある「Filename_バックアップ」フォルダに保存
    .Close
    'バックアップ作成
    
    End With

'バックアップファイルの作成-------

'進捗管理シートに各種情報を記入---

    Cells(連番 + 1, 4).Value = Time
    Cells(連番 + 1, 5).Value = "=HOUR(D" & 連番 + 1 & "-C" & 連番 + 1 & ")*60+MINUTE(D" & 連番 + 1 & "-C" & 連番 + 1 & ")"
    '=HOUR(D2-C2)*60+MINUTE(D2-C2)
    Cells(連番 + 1, 7).Value = 終了字数
    Cells(連番 + 1, 8).Value = "=(G" & 連番 + 1 & "-F" & 連番 + 1 & ")"
    Cells(連番 + 1, 9).Value = "=(H" & 連番 + 1 & "/E" & 連番 + 1 & "*60)"

'進捗管理シートに各種情報を記入---
       
    
    Set wdDoc = Nothing
    Word.Application.Quit
   

    End
    
End Sub

こちらもやることはコードそのままです。
バックアップファイルを作成して、各種情報のための数式を記入する。
ファイルを立ち上げるコードをもう一度書いているのは、既に開いているファイルを取得するという方式が上手くいかなかったからです。
「既に開いているファイルです」みたいなメッセージを表示させないために「ReadOnly:=True」を埋め込んで、読み取り専用として開き、各種情報を取得したらそのまま閉じるという方式にしました。

使った感想
便利な点
・気持ちのオンオフの切り替えがしやすい。
定量的なデータが取れる。特に1時間にどれくらい書けるかが分かって工数予測がしやすかった。
・バックアップファイルの自動作成。言わずもがな。

課題
スマホで使えない。マクロがオンラインでは利用できないため。
・onedriveで使えない。onedriveはディレクトリのパスが変になるため。
・タイトルを変えると対応できない。
・(このツールを作成したら満足して肝心の執筆活動は大して進まなかったこと)

参考にしたサイト
Excel VBA Wordを操作する主なプロパティとメソッド

上述のonedrive問題は下記のサイトの方法で解決可能?
VBAでOneDriveに保存してあるファイルのパスが「https://d.docs.live.net/」になって困った時の解決法はコレだ | 気楽生活 - OFFICE & OUTDOOR -