なぜ作ったか
弊社は議事録がまだ手動作成であり、その際に日付の後ろに曜日を入力することが求められるのですが一つ一つ確認する手間に腹が立ったので自動化しました。
そしてあわよくば同じような境遇の方がいたさいにその方の助けになればと思います。
実際のコード
Sub Word文書の文字列を一行ずつ取得する()
Dim pg As Page
Dim rc As Rectangle
Dim ln As Line
Dim temp() As String
Dim tempDate As Variant
With ActiveWindow
.View.Type = wdPrintView
For Each pg In .ActivePane.Pages
For Each rc In pg.Rectangles
On Error Resume Next
For Each ln In rc.Lines
If rc.RectangleType = wdTextRectangle Then
If ln.Range.Text Like "*[0-90-9][//][0-90-9]*" And Len(Replace(Replace(Replace(ln.Range.Text, vbTab, ""), vbCr, ""), " ", "")) > 5 Then
ln.Range.Text = DateConvert(ln.Range.Text)
End If
End If
Next ln
Next rc
Next pg
End With
End Sub
Function DateConvert(s As String) As String
Dim i As Long
Dim startStringCount As Long
Dim endStringCount As Long
Dim j As Long
Dim tempDate As String
Dim tempString As String
Dim res As String
Dim firstFlag As Boolean
firstFlag = True
DateConvert = s
For i = 1 To Len(DateConvert)
If IsNumeric(Mid(DateConvert, i, 1)) = True Then
startStringCount = i
For j = 1 To 10
If Not (Mid(DateConvert, i + j, 1) Like "[0-90-9//]") Then
endStringCount = i + j
Exit For
End If
Next
tempDate = Mid(DateConvert, startStringCount, endStringCount - startStringCount)
tempString = Mid(DateConvert, startStringCount, endStringCount - startStringCount + 3)
If EraseWeekDay(tempString) Like "*|" Then
i = i + (endStringCount - startStringCount)
Else
If JudgeIsDate(tempDate) = True Then
DateConvert = Replace(DateConvert, tempDate, GetWeekDay(tempDate))
i = i + (endStringCount - startStringCount)
Else
i = i + (endStringCount - startStringCount)
End If
End If
End If
Next
End Function
Function GetWeekDay(s As String) As String
Dim tempWeekDay As String
If Year(s) < 2019 Or Year(s) > 2100 Then
GetWeekDay = s
Else
If Len(s) < 6 Then
If Month(s) > 9 Then
If Month(Date) < 4 Then
tempWeekDay = WeekdayName(Weekday(Year(Date) - 1 & "/" & s), True)
End If
ElseIf Month(s) < 4 Then
If Month(Date) > 9 Then
tempWeekDay = WeekdayName(Weekday(Year(Date) + 1 & "/" & s), True)
End If
End If
If tempWeekDay = "" Then
tempWeekDay = WeekdayName(Weekday(Year(Date) & "/" & s), True)
End If
Else
tempWeekDay = WeekdayName(Weekday(s), True)
End If
GetWeekDay = s & "(" & tempWeekDay & ")"
End If
End Function
Function EraseWeekDay(s As Variant) As String
Dim reg
Dim pat As String
Dim rep As String
Set reg = CreateObject("VBScript.RegExp")
pat = "[\((][月火水木金土日][\))]"
With reg
.Pattern = pat
.IgnoreCase = True
.Global = True
End With
EraseWeekDay = reg.Replace(s, "|")
End Function
Function JudgeIsDate(s As String) As Boolean
Dim reg
Dim pat As String
Dim rep As String
Set reg = CreateObject("VBScript.RegExp")
pat = "^([22][00][0-90-9]{2}[//])?([00][1-91-9]|[11][0-20-2]|[1-91-9])[//]([00][1-91-9]|[1212][0-90-9]|[33][0-10-1]|[1-91-9])$"
With reg
.Pattern = pat
.IgnoreCase = True
.Global = True
End With
JudgeIsDatea = False
If reg.Replace(s, "") = "" Then JudgeIsDate = True
End Function
わかりづらそうな部分をちょっと解説
一行ずつ文章を読み込み、日付を見つけて曜日を付けます。
元々曜日が入力されていればそのまま無視します。
最初の一行ずつ取得する部分はこちらのサイトよりお借りいたしました。
ページ番号かどうかの判定
ページ番号(例:1/3)なども取得するようで、日付として判定してしまうため、以下で除外するようにしました。
タブや改行コードや空白を消したうえで、5文字以下であればページ番号として判定するようにしています。(議事録内で一行に5文字以下のもので日付はなかったため)
Word文書の文字列を一行ずつ取得する
If ln.Range.Text Like "*[0-90-9][//][0-90-9]*" And Len(Replace(Replace(Replace(ln.Range.Text, vbTab, ""), vbCr, ""), " ", "")) > 5 Then
ln.Range.Text = DateConvert(ln.Range.Text)
曜日をつける部分
EraseWeekDay関数内で、処理前に曜日部分をパイプに置き換えて曜日が既に入っているかを判定し、入っていなければ日付を日付+曜日でReplaceします
DateConvert
If EraseWeekDay(tempString) Like "*|" Then
i = i + (endStringCount - startStringCount)
Else
If JudgeIsDate(tempDate) = True Then
DateConvert = Replace(DateConvert, tempDate, GetWeekDay(tempDate))
i = i + (endStringCount - startStringCount)
Else
i = i + (endStringCount - startStringCount)
End If
End If
日付判定
以下正規表現に合致すれば日付だと判定しています。
JudgeIsDate
pat = "^([22][00][0-90-9]{2}[//])?([00][1-91-9]|[11][0-20-2]|[1-91-9])[//]([00][1-91-9]|[1212][0-90-9]|[33][0-10-1]|[1-91-9])$"
最後に
ただの備忘録的な感じなので雑ですみません。
ここよくわからないんだけど!という部分があれば追記いたします。