2
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

[Wordマクロ/VBA]曜日を自動で入力してくれるマクロ

Posted at

なぜ作ったか

弊社は議事録がまだ手動作成であり、その際に日付の後ろに曜日を入力することが求められるのですが一つ一つ確認する手間に腹が立ったので自動化しました。
そしてあわよくば同じような境遇の方がいたさいにその方の助けになればと思います。

実際のコード
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])$"

最後に

ただの備忘録的な感じなので雑ですみません。
ここよくわからないんだけど!という部分があれば追記いたします。

2
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
2
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?