見出し画像

漢文の訓点２【素人 Word マクロ　ツール】

遊(文法、日本語学、国語教育)

Microsoft officeのWordVBAでマクロを組みましたので公開します。
インターネットで検索したり、マクロの記録機能を使ったりしたのを組み合わせだけなので、上手くはないですが、一応動くはずです。
office2021です。
必ず、元データのバックアップを取ってから実行してください。
素人の作ったものなので、信用しすぎないでください。


［内容］

ワード縦書きの文書に対して実行すると、①返り点は下付き文字(縦書きだと左下)かつ文字間隔を調整、②送り仮名は上付き文字(縦書きだと右下)かつ文字列を、より右に設定します。
返り点→「レ、一、二、三、四、上、中、下、甲、乙、丙、天、地、人」
送り仮名→全角カタカナ
また、再読文字の送り仮名について、あとから入力できる形で漢字の左下に変換します。

角書きも組み文字もルビもフィールドコードの手入力も使わないのが特徴です。

［画像］


元データ
マクロ実行後
元データ
マクロ実行後
振り仮名（ルビ）も共存可能
元データ
マクロ実行後
再読文字の仮名と一レ点の文字間を調整

［注意点］

❶以下の記号を代用しています。

レ→れ
一→い
二→に
三→さ
四→よ
上→じょ
中→ちゅ
下→げ
甲→こ
乙→お
丙→へ
天→て
地→ち
人→じ
再読文字の送り仮名がある箇所→さい
二とハイフン→には

たとえば、「子曰ク、學ビテ而時ニ習れフ之ヲ、不に亦タ説いバシカラ乎。有げリ朋自にリ遠方い來じょタル、不に亦タ樂いシカラ乎。人不れシテ知ラ而不れ慍ミ、不に亦タ君子いナラ乎ト」と入力されている必要があります。

代用しないでおく方法もありますが、その場合、本文中の返り点でない漢字まで、返り点に変えてしまう可能性もあります。もしくは、〈上〉などと囲んでおき、それを置換する方法もあるでしょう。マクロを改造してみてください。

❷一レ、上レ点が繋がるように対応していますが、字間が気に入らない場合は手作業で修正してください。
❸再読文字の送り仮名は手作業で打ち込んでください。
❹テストで使用するような傍線部とは共存できません。

［コード］

Sub 訓点２()

' フォントサイズは１１ptが基本
'　レれ・一い・二に・三さ・四よ・上じょ・中ちゅ・下げ・甲こ・乙お・丙へ・天て・地ち・人じ、と入力する
'　再読文字の送り仮名は、「さい」と入力しておく。それ以外はカタカナでそのまま
'　ハイフンは、「には」と入力しておく

' カタカナを上付き、文字の配置を7pt上げる
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = True
        .Subscript = False
        .Position = 7
    End With
    With Selection.Find
        .Text = "[ァ-ヾ]"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'　一レ点
ActiveDocument.Content.Select
 Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -2
    End With
    With Selection.Find
        .Text = "いれ"
        .Replacement.Text = "一れ"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'上レ点
ActiveDocument.Content.Select
  Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Underline = wdUnderlineNone
        .Superscript = False
        .Subscript = True
        .Spacing = -1
    End With
    With Selection.Find
        .Text = "じれ"
        .Replacement.Text = "上れ"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'二とハイフン
ActiveDocument.Content.Select
 Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Underline = wdUnderlineSingle
        .Superscript = False
        .Subscript = True
    End With
    With Selection.Find
        .Text = "には"
        .Replacement.Text = "二"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll



'再読文字の送り仮名
　ActiveDocument.Content.Select
   Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Underline = wdUnderlineNone
        .Superscript = False
        .Subscript = True
        .Position = -6
    End With
    With Selection.Find
        .Text = "さい"
        .Replacement.Text = "再読カナ"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' レ点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "れ"
 　　　　.Replacement.Text = "レ"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'　一点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "い"
        .Replacement.Text = "一"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
   '　二点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "に"
        .Replacement.Text = "二"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
     
    '　三点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "さ"
        .Replacement.Text = "三"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'　四点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "よ"
        .Replacement.Text = "四"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'　上点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "じょ"
        .Replacement.Text = "上"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'　中点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "ちゅ"
        .Replacement.Text = "中"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'　下点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "げ"
        .Replacement.Text = "下"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'　甲点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "こ"
        .Replacement.Text = "甲"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll


'　乙点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "お"
        .Replacement.Text = "乙"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'　丙点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "へ"
        .Replacement.Text = "丙"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'　天点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "て"
        .Replacement.Text = "天"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    

'　地点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "ち"
        .Replacement.Text = "地"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'　人点
    ActiveDocument.Content.Select
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
        .Spacing = -4
    End With
    With Selection.Find
        .Text = "じ"
        .Replacement.Text = "人"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    
End Sub

［マクロについて］

ファイルタブ→その他→オプション→ユーザーのリボン設定→開発タブを追加、でマクロが導入できます。検索してください。

素人の作ったものなので、信用しすぎないでください。


この記事が参加している募集

#国語がすき

3,801件

#古典がすき

4,004件

この記事が気に入ったらサポートをしてみませんか？