Vorsorge

雑記帳

【vba】【裁判例用】選択範囲の漢数字を算用数字に変換(メモ)

Sub 裁判例用()
'
' 選択範囲の漢数字を英数字に置換
'

    Dim a_漢数字(0 To 9) As String
    
    a_漢数字(0) = "〇"
    a_漢数字(1) = "一"
    a_漢数字(2) = "二"
    a_漢数字(3) = "三"
    a_漢数字(4) = "四"
    a_漢数字(5) = "五"
    a_漢数字(6) = "六"
    a_漢数字(7) = "七"
    a_漢数字(8) = "八"
    a_漢数字(9) = "九"
    
    Dim i_千 As Integer
    Dim i_百 As Integer
    Dim i_十 As Integer
    Dim i_一 As Integer

    '初期化
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    
    '4000からのカウントダウン
    For i = 4000 To 1 Step -1
        i_一 = i Mod 10
        i_十 = ((i Mod 100) - i_一) \ 10
        i_百 = ((i Mod 1000) - (i_十 * 10 + i_一)) \ 100
        i_千 = i \ 1000

        
        With Selection.Find
            If i >= 1000 Then
                .Text = a_漢数字(i_千) & a_漢数字(i_百) & a_漢数字(i_十) & a_漢数字(i_一) & "([条項号年月日巻頁])"
            ElseIf 1000 > i And i >= 100 Then
                .Text = a_漢数字(i_百) & a_漢数字(i_十) & a_漢数字(i_一) & "([条項号年月日巻頁])"
            ElseIf 100 > i And i >= 10 Then
                .Text = a_漢数字(i_十) & a_漢数字(i_一) & "([条項号年月日巻頁])"
            Else
                .Text = a_漢数字(i_一) & "([条項号年月日巻頁])"
            End If
            
            .Replacement.Text = i & "\1"
            
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchFuzzy = False
            .MatchWildcards = True
        End With

        Selection.Find.Execute Replace:=wdReplaceAll 
    Next
    
    With Selection.Find
        .Text = " ("
        .Replacement.Text = "("
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    With Selection.Find
        .Text = ") "
        .Replacement.Text = ")"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^p "
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub