Wordで日時計算

# word で 日時計算
とある予約管理システムで、次回予約を登録し、その「予約案内」をプリントして、顧客に渡す。
予約案内書式は、予め　word　で作成しシステム登録してある。
予約完了時に表示するので、内容確認、追記などを行い、印刷終了すると、システムに保存される。
このシステムはクライアントサーバ型システムである。

<b>予約案内のイメージ</b>
<img width="500" alt="YM20060200.png" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/d1c82106-597b-80e0-7d0a-fe87361a8cb1.png">

@お客様番号や@予約日は、予約管理システムで決められた書式です。
ファイルを開くと予約内容で置き換えられて表示されます。

<b>実際のプリントイメージ</B>
<img width=500 alt=YM20060201.png] src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/7163c333-d552-791d-bcf1-431f208f9cd6.png>

特別問題無いよう見えるのですが、実際使うと20分前に来てくれない方が多いようです。

<b>改良のプリントイメージ</b>
<img width=500 alt=YM20060202.png src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/2aea2a98-e04e-6c54-8cdf-8fa6cc8b023a.png>

Excelであれば、計算式で対応できるのですが、Wordなので、こんな手を使いました。

#ブックマーク名にルール
<img width=500 alt=YM20060203.png src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/0f744a38-5307-972d-3290-01fd0ff413d9.png>
ブックマークをつける文字とブックマーク名
@予約日：予日
@予約時刻：予時
@予約日の２日前：日前2　　　　　　　　 予約日の２日前の日付に置き換える
@予約日の２日後：日後2　　　　　　　　 予約日の２日後の日付に置き換える
@予約時間の２０分前：時前0020　　　　　予約時刻の０時間２０分前の時刻に置き換える
@予約時間の１時間３０分後：時後0130　　予約時刻の１時間３０分後の時刻に置き換える
<img width=300 alt=YM20060204.png src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/343fdcb4-8ced-e26e-1829-ba9856e0051b.png>
この関係をマクロにして、ブックマークを更新すれば、出来上がり。
しかし、word単体では、日時計算が出来ません。
このシステムの事情なのだろうが、Document_Openが終わらないと予約語の置き換えが始まらい。

#wordからvbscriptを非同期起動して、起動元のwordを操作する
###起動するvbsを毎回作成する。
```vbs:MakeVBS
'-----------------------------------------------------------------------------
' vbsプログラムファイルを作成する
' d:\word\[wordファイル名]wordMacro.vbs
' ファイルが存在する場合は、上書き保存する
'-----------------------------------------------------------------------------
Private Sub MakeVBS(ByVal OutPutPath As String)
   Dim fso As Object
   Dim TextStream As Object

   Dim vbsfile As Object

   Set fso = CreateObject("Scripting.FileSystemObject")
   Set vbsfile = fso.CreateTextFile(OutPutPath, True)
   With vbsfile
        .WriteLine ("'-----------------------------------------------------------")
        .WriteLine ("'d:\word\[wordファイル名]wordMacro.vbs 次回予約1.vbs.docm")
        .WriteLine ("'引数:処理対象のwordのファイル名")
        .WriteLine ("'-----------------------------------------------------------")
        .WriteLine ("")
        .WriteLine ("'--------------------------------")
        .WriteLine ("'引数受取")
        .WriteLine ("'--------------------------------")
        .WriteLine ("if WScript.Arguments.Count <> 1 then")
        .WriteLine ("   WScript.Quit")
        .WriteLine ("end if")
        .WriteLine ("targetfilename = WScript.Arguments(0)")
        .WriteLine ("")
        .WriteLine ("'--------------------------------")
        .WriteLine ("'wordのオブジェクト化")
        .WriteLine ("'--------------------------------")
        .WriteLine ("on error resume next")
        .WriteLine ("set objword = GetObject(,""Word.Application"")")
        .WriteLine ("if Err.Number <> 0 then")
        .WriteLine ("   WScript.Quit")
        .WriteLine ("end if")
        .WriteLine ("on error goto 0")
        .WriteLine ("do")
        .WriteLine ("   if objword.Documents.Count=0 then exit do end if")
        .WriteLine ("   getobjf = false")
        .WriteLine ("   for i=1 to objword.Documents.Count")
        .WriteLine ("      if objword.Documents(i).name = targetfilename then")
        .WriteLine ("         set objword = objword.Documents(i)")
        .WriteLine ("         getobjf = true")
        .WriteLine ("         exit for")
        .WriteLine ("      end if")
        .WriteLine ("   next")
        .WriteLine ("   if getobjf = false then exit do end if")
        .WriteLine ("")

        ここに処理を書く
　　　　ブックマークから日時を取り出したり
　　　　ブックマーク名に従って、日付や時間を足したり、引いたり

        .WriteLine ("loop")
        .WriteLine ("set objword = nothing")
        .Close
   End With
```
###vbscriptを非同期で起動するには
システムの制約で複数のwordが開くことはないのですが、PCでwordを使っていることを想定して、呼び出し元ドキュメント名を渡します

```vbs:非同期起動
       Shell "WScript.exe """ & ""d:\word\"" & ActiveDocument.Name & "wordMacro.vbs" & """ """ & ActiveDocument.Name & """"
```

#vbscriptでwordを操作する
###wordをオブジェクト化
```vbs:wordオブジェクト化
set objword = GetObject(,"Word.Application")
for i=1 to objword.Documents.Count
    if objword.Documents(i).name = "〇〇.doc" then
       set objword = objword.Documents(i)
       exit for
    end if
next
```
###ブックマークから値取得
```vbs:Bookmarks
   for each bkm in objword.Bookmarks
      select case mid(trim(bkm.name),1,2)
        case "予日"
             DateStr = trim(bkm.Range.Text)
        case "予時"
             TimeStr = trim(bkm.Range.Text)
      end select
   next
```

###日計算とブックマーク値更新
日前n:予日のn日前
日後n:予日のn日後

```vbs:DateAdd
      for each bkm in objword.Bookmarks
        select case mid(trim(bkm.name),1,2)
           case "日前"
                wk = right(trim(bkm.name),1)
                if isnumeric(wk) then
                   wk = DateAdd("D", wk*-1, yoyakuDate)
                   bkm.Range.Text = FormatDateTime(wk, 2)
                end if
           case "日後"
                wk = right(trim(bkm.name),1)
                if isnumeric(wk) then
                   wk = DateAdd("D", wk, yoyakuDate)
                   bkm.Range.Text = FormatDateTime(wk, 2)
                end if
         end select
      next
```

###時刻計算とブックマーク値更新
時前hhmm:予時のhh時間mm分前
時後hhmm:予時のhh時間mm分後

```vbs:date
      for each bkm in objword.Bookmarks
         select case mid(trim(bkm.name),1,2)
           case "時前"
                wk = right(trim(bkm.name),4)
                if isnumeric(wk) then
                   wk = cdate(yoyakuTime)-cdate(left(wk,2)&":"&right(wk,2))
                   bkm.Range.Text =  Replace(FormatDateTime(wk, 4), ":", "時")&"分"
                end if
           case "時後"
                wk = right(trim(bkm.name),4)
                if isnumeric(wk) then
                   wk = cdate(yoyakuTime)+cdate(left(wk,2)&":"&right(wk,2))
                   bkm.Range.Text = Replace(FormatDateTime(wk, 4), ":", "時")&"分"
                end if
         end select
      next
```
#word起動時に自動処理する。

```vbs:Document_Open
Private Sub Document_Open()
```

#ブックマーク更新は最初に開いた時だけ（このシステムの特殊事情に合わせました）
何度でもお開けるが、ブックマーク更新は最初に開いた時だけ
なので、ブックマークは削除する。

```vbs:Bookmarks.Delete
    For Each bkm In objword.Bookmarks
        Select Case Mid(Trim(bkm.Name), 1, 2)
          Case "日前", "日後", "時前", "時後"
               bkm.Delete
        End Select
    Next
```
これで、初回以外はブックマーク更新しません。

[物忘れ防止 次回予約案内説明用.docm ](https://github.com/sugita0301/douzo/blob/master/%E6%AC%A1%E5%9B%9E%E4%BA%88%E7%B4%84%E6%A1%88%E5%86%85%E8%AA%AC%E6%98%8E%E7%94%A8.zip)
https://github.com/sugita0301/douzo