【同人小説】源暎こぶり/ちくご明朝の縦書き濁点喘ぎ変換ワードマクロ

Sub 原稿用一括置換()
'
' 原稿用一括置換マクロ
' 濁点、～、!!、!?を縦書き用に整形
' ◆→ハートに置換するよ

'実行前のバックアップと、実行後の目視チェックは忘れず行ってください。
'原稿がどうなっても自己責任でお願いします。

'制作者　https://note.com/kashiri

   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
       .Text = "!!"
       .Replacement.Text = ChrW(8252) '縦書き用の「!!」
       .Forward = True
       .Wrap = wdFindContinue
       .MatchWildcards = False
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "!?"
       .Replacement.Text = ChrW(8265) '縦書き用の「!?」
       .Forward = True
       .Wrap = wdFindContinue
       .MatchWildcards = False
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "゛"
       .Replacement.Text = ChrW(12441) '縦書き用の濁点
       .Forward = True
       .Wrap = wdFindContinue
       .MatchWildcards = False
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = "～"
       .Replacement.Text = ChrW(12336) '縦書き用の「～～」
       .Forward = True
       .Wrap = wdFindContinue
       .MatchWildcards = False
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   '不要なら消してよし↓---------------------------------------
   With Selection.Find
       .Text = "◆" '任意の記号に置き換えてよし
       .Replacement.Text = ChrW(9825) '白いハートマーク
       .Forward = True
       .Wrap = wdFindContinue
       .MatchWildcards = False
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   '不要なら消してよし↑---------------------------------------
      
       
End Sub

Sub 原稿用一括置換を戻す()

'「原稿用一括置換」を元に戻すよ
'ウェブ再録するときとかに使おう

' 縦書き用の濁点、～、!!、!?を元に戻す
' ハート→◆に置換するよ

'実行前のバックアップと、実行後の目視チェックは忘れず行ってください。
'原稿がどうなっても自己責任でお願いします。

'制作者　https://note.com/kashiri
'
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
       .Text = ChrW(8252) '縦書き用の「!!」
       .Replacement.Text = "!!"
       .Forward = True
       .Wrap = wdFindContinue
       .MatchWildcards = False
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
       .Text = ChrW(8265) '縦書き用の「!?」
       .Replacement.Text = "!?"
       .Forward = True
       .Wrap = wdFindContinue
       .MatchWildcards = False
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   '濁点戻しはこの後実行する
   
   With Selection.Find
       .Text = ChrW(12336) '縦書き用の「～～」
       .Replacement.Text = "～"
       .Forward = True
       .Wrap = wdFindContinue
       .MatchWildcards = False
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   '不要なら消してよし↓---------------------------------------
   With Selection.Find
       .Text = ChrW(9825) '白いハートマーク
       .Replacement.Text = "◆" '任意の記号に置き換えてよし
       .Forward = True
       .Wrap = wdFindContinue
       .MatchWildcards = False
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   '不要なら消してよし↑---------------------------------------
      
   濁点戻し
   
End Sub

Sub 濁点戻し()

'縦書き用に結合した濁点を全角の「゛」に戻します。

   With Selection.Find
       .Text = "([ぁ-ん])" & ChrW(12441) 'ひらがなすべて＆結合用濁点
       .Replacement.Text = "\1゛"
       .Wrap = wdFindContinue
       .MatchWildcards = True
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   With Selection.Find
       .Text = "([ァ-ヴ])" & ChrW(12441) 'カタカナすべて＆結合用濁点
       .Replacement.Text = "\1゛"
       .Wrap = wdFindContinue
       .MatchWildcards = True
       .MatchFuzzy = False
       .MatchByte = True
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   

   
   'ほか、漢字や記号に濁点をつけちゃった場合は想定外ですが、
   '一応、以下のコメントアウトしてあるヤツは使えると思います。
   'コメント（「'」）を消して実行してみてください。
   
   
'    'すべての文字について置換する。
'    'ガチで「すべて」なので誤作動が怖い。普段は一応コメントアウトしておく
'    With Selection.Find
'        .Text = "(?)" & ChrW(12441) 'すべての文字＆結合用濁点
'        .Replacement.Text = "\1゛"
'        .Wrap = wdFindContinue
'        .MatchWildcards = True
'        .MatchFuzzy = False
'        .MatchByte = True
'    End With
'    Selection.Find.Execute Replace:=wdReplaceAll
   
   
End Sub