Wordで日時計算

8993 ワード
電子カルテ 日時計算 Word VBScript マクロ VBScript テキストリンク

word で 日時計算

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

予約案内のイメージ

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

実際のプリントイメージ

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

改良のプリントイメージ

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

ブックマーク名にルール


ブックマークをつける文字とブックマーク名
@予約日：予日
@予約時刻：予時
@予約日の２日前：日前2　　　　　　　　 予約日の２日前の日付に置き換える
@予約日の２日後：日後2　　　　　　　　 予約日の２日後の日付に置き換える
@予約時間の２０分前：時前0020　　　　　予約時刻の０時間２０分前の時刻に置き換える
@予約時間の１時間３０分後：時後0130　　予約時刻の１時間３０分後の時刻に置き換える

この関係をマクロにして、ブックマークを更新すれば、出来上がり。
しかし、word単体では、日時計算が出来ません。
このシステムの事情なのだろうが、Document_Openが終わらないと予約語の置き換えが始まらい。

wordからvbscriptを非同期起動して、起動元のwordを操作する

起動する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を使っていることを想定して、呼び出し元ドキュメント名を渡します

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

vbscriptでwordを操作する

wordをオブジェクト化

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

ブックマークから値取得

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日後

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分後

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起動時に自動処理する。

Document_Open
Private Sub Document_Open()

ブックマーク更新は最初に開いた時だけ（このシステムの特殊事情に合わせました）

何度でもお開けるが、ブックマーク更新は最初に開いた時だけ
なので、ブックマークは削除する。

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