見出し画像

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

うわ~ん、ドラえも~ん!
濁点エロスケベ喘ぎを書いたはいいけど、縦書きの原稿用テンプレートにコピペした途端台無しになっちゃったよ~!!
そういう経験、みなさんにはありますか? 誰しもあると思います。

そんなみだらなのび太くんにオススメなのがこれ、縦書き濁点喘ぎ変換ワードマクロ~!!

画像2

このワードマクロは、「F5ボタン1回押し」OR「マクロの実行」で以下の置換作業を一気に行います。ユニコードかなんか使いましたが忘れました。

・半角の「!!」を縦書き用の「!!」に置換
・半角の「!?」を縦書き用の「!?」に置換
・全角の「゛」を結合用濁点に置換
・全角の「~~」を結合された波線に置換
・全角の「◆」を「ハートマーク」に置換

※ちなみに、「――」(ダッシュ)は字間設定が0の源暎明朝では勝手に結合されます。
※最後の「◆」は不要な方は消してください。別の記号がよかったらそこだけ書き換えてください。
※動作は源暎こぶり明朝・源暎ちくご明朝フォントで確認
(このフォントは、結合用濁点をつかえば濁点表示がきれいにできるように、作者さまの厚意により濁点付きグリフがあります。)

追記
夜永オールド明朝3以降でも使用可能と紹介いただきました❣


これをVisualBasicでインポートし、カーソルを合わせ、F5ボタンを押せば、勝手に5連続で置換作業が走ります。マクロについてはググってくれ。
(下に導入法の解説追記しました)

マクロの注意点ですが、上記のルールの通り変換されるので、「?!」「!!!」(奇数個)などの例外ではうまく変換されません。ご注意を。

マクロを使った結果について何の責任もおいません。自己責任で、必ずバックアップをしてからやってください。

[追記]
おまけに、ワードのテンプレはこちらで配布中。

【文庫サイズテンプレはこちら】
【A5サイズテンプレはこちら】

「ミサトさぁん!マクロが難しくて分かんないよぉ!」という方は、こちらをDLして縦書き用の文字をコピペするなり手作業で置換するなりが可能です。


【だいぶ後の追記】2023/10/01
下に書いた[追記:導入法]より、もっと簡単な導入法がありました!
当マクロを紹介してくださったこちらの記事「エロ夢小説・夢漫画を同人誌にしよう!②原稿を作る」のおかげです。
下にも補記したけど、こちらの記事のほうがスクショ画像もあって分かりやすかったから見て!(紹介の許可をくださりありがとうございました♡)

操作法
表示タブ>マクロ>マクロの表示(でポップアップウインドウが出る)

マクロの「編集」(で開発ウインドウが出る)
⇒ファイル>ファイルのインポート で、DLした「縦書き濁点原稿用ver2.1.bas」をインポートします

※ちなみに、「インポート」は開発ウインドウのここに
「縦書き濁点原稿用ver2.1.bas」をドラッグしても可能です

その後「マクロを表示」の一覧に「原稿用一括置換」が並びますので、それを選択して実行

エロ夢小説・夢漫画を同人誌にしよう!②原稿を作る」より

[追記:導入法]
マクロをボタン一発で実行してラクしたい人へ

このページを参考にしてどうぞ。このマクロを一回だけサッと使う場合、以下は不要です。
・VBEのオプション設定
・イミディエイトウィンドウを開く
・VBAをマクロ有効文書として保存する

上記ページどおりにやって、「標準モジュール」の下にインポート、あるいはコピペでこの画像のようになればOKです。名前は適当でいいです。

画像2

この状態で、使いたい「Sub」内をクリックします。続けてキーボードの「F5」ボタンを押します。すると、ワード文書で置換作業が自動的に行われます。
クッソ楽です。同時に本三冊出した俺が言うんだから間違いない。


コードは以下に全文貼っときます。インポートでなくこちらをコピペでもOK。
ワードの開発タブ→VisualBasic→標準モジュール等に貼り付け、F5で動きます。

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


え? まず原稿がないって?
はい、こういう記事~(同人えもん)

【さらに追記】2021/6/14
ワードのバージョンや検索の設定により、マクロがうまく動かない場合に備えたプロパティを追加しました。(半角と全角を区別するように設定)
以前のバージョンを使っていた方は、上書きしてください。

また、以前は「横書き→縦書き」のみの変換だったのですが、「縦書き→横書き」に戻す操作も増やしました。
全責任はとれませんが、原稿をウェブ再録する時間が短縮できるはず。


石油王の方へ 役に立ったらお紅茶花伝1本分のおサポートをお願いします。だいじに執筆に使わせていただきます!