漢文の訓点2【素人 Word マクロ ツール】
Microsoft officeのWordVBAでマクロを組みましたので公開します。
インターネットで検索したり、マクロの記録機能を使ったりしたのを組み合わせだけなので、上手くはないですが、一応動くはずです。
office2021です。
必ず、元データのバックアップを取ってから実行してください。
素人の作ったものなので、信用しすぎないでください。
[内容]
ワード縦書きの文書に対して実行すると、①返り点は下付き文字(縦書きだと左下)かつ文字間隔を調整、②送り仮名は上付き文字(縦書きだと右下)かつ文字列を、より右に設定します。
返り点→「レ、一、二、三、四、上、中、下、甲、乙、丙、天、地、人」
送り仮名→全角カタカナ
また、再読文字の送り仮名について、あとから入力できる形で漢字の左下に変換します。
角書きも組み文字もルビもフィールドコードの手入力も使わないのが特徴です。
[画像]
[注意点]
❶以下の記号を代用しています。
レ→れ
一→い
二→に
三→さ
四→よ
上→じょ
中→ちゅ
下→げ
甲→こ
乙→お
丙→へ
天→て
地→ち
人→じ
再読文字の送り仮名がある箇所→さい
二とハイフン→には
たとえば、「子曰ク、學ビテ而時ニ習れフ之ヲ、不に亦タ説いバシカラ乎。有げリ朋自にリ遠方い來じょタル、不に亦タ樂いシカラ乎。人不れシテ知ラ而不れ慍ミ、不に亦タ君子いナラ乎ト」と入力されている必要があります。
代用しないでおく方法もありますが、その場合、本文中の返り点でない漢字まで、返り点に変えてしまう可能性もあります。もしくは、〈上〉などと囲んでおき、それを置換する方法もあるでしょう。マクロを改造してみてください。
❷一レ、上レ点が繋がるように対応していますが、字間が気に入らない場合は手作業で修正してください。
❸再読文字の送り仮名は手作業で打ち込んでください。
❹テストで使用するような傍線部とは共存できません。
[コード]
Sub 訓点2()
' フォントサイズは11ptが基本
' レれ・一い・二に・三さ・四よ・上じょ・中ちゅ・下げ・甲こ・乙お・丙へ・天て・地ち・人じ、と入力する
' 再読文字の送り仮名は、「さい」と入力しておく。それ以外はカタカナでそのまま
' ハイフンは、「には」と入力しておく
' カタカナを上付き、文字の配置を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
[マクロについて]
ファイルタブ→その他→オプション→ユーザーのリボン設定→開発タブを追加、でマクロが導入できます。検索してください。
素人の作ったものなので、信用しすぎないでください。
この記事が気に入ったらサポートをしてみませんか?