青空文庫Word変換【素人 Word マクロ】

Microsoft officeのWordVBAでマクロを組みましたので公開します。

インターネットで検索したり、マクロの記録機能を使ったりしたのを組み合わせだけなので、上手くはないですが、一応動くはずです。

office2021です。

必ず、元データのバックアップを取ってから実行してください。

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

[内容]

青空文庫のHTML表示をコピーしてWordに貼り付けると、見た目が整っていません。
下記のサイトを参考にして、マクロを作成しました。

青空文庫をワードファイルにする方法 - Senobi

Word ルビの大きさ一括処理

先日、テキストとしてダウンロードして、ルビを設定しようとしたのですが、あまり上手くいきませんでした。

---

[注意点]

縦書きか横書きかを選択する必要があります。

---

[画像]

変換前

横書きに変換

縦書きに変換

---

[コード]

Sub 青空文庫Word変換()

    Dim userChoice As Integer
    Dim fontName As String
    Dim fontSize As Single
    Dim lineSpacing As Single
    Dim message As String
    
    ' ユーザーに「縦書き」または「横書き」を選択させる
    userChoice = MsgBox("縦書きにしますか？：" & vbCrLf & vbCrLf & "はい→縦書き" & vbCrLf & "いいえ→横書き", vbExclamation + vbYesNo, "テキストの方向を選択")
    
    ' ユーザーの選択に応じて処理を実行
    If userChoice = vbYes Then
        ' 縦書きの場合
        fontName = "BIZ UDP明朝 Medium"
        fontSize = 10.5
        lineSpacing = 20
        
        ' 全選択し、フォントとポイントを変更
        Selection.WholeStory
        Selection.Font.Name = fontName
        Selection.Font.Size = fontSize
        
        ' フィールドコートを開く
        Selection.Fields.ToggleShowCodes
        
        ' テキストの置換
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Font.Name = fontName
        With Selection.Find
            .Text = "hps27"
            .Replacement.Text = "hps10"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        
        With Selection.Find
            .Text = "メイリオ"
            .Replacement.Text = "BIZ UDP明朝 Medium"
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        
        With Selection.Find
            .Text = "up 11"
            .Replacement.Text = "up 9"
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        
        ' フィールドコートを閉じる
        Selection.Fields.ToggleShowCodes
        
        ' テキストの方向を縦書きに変更
        Selection.Orientation = wdTextOrientationVerticalFarEast
        
        ' 行間を設定
    With Selection.ParagraphFormat
        .LeftIndent = MillimetersToPoints(0)
        .RightIndent = MillimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceExactly
        .lineSpacing = 30
        .Alignment = wdAlignParagraphJustify
        .WidowControl = False
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = MillimetersToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
        .CollapsedByDefault = False
        .AutoAdjustRightIndent = True
        .DisableLineHeightGrid = False
        .FarEastLineBreakControl = True
        .WordWrap = True
        .HangingPunctuation = True
        .HalfWidthPunctuationOnTopOfLine = False
        .AddSpaceBetweenFarEastAndAlpha = True
        .AddSpaceBetweenFarEastAndDigit = True
        .BaseLineAlignment = wdBaselineAlignAuto
    End With

        
    ElseIf userChoice = vbNo Then
        ' 横書きの場合
        fontName = "BIZ UDP明朝 Medium"
        fontSize = 10.5
        lineSpacing = 20
        
        ' 全選択し、フォントとポイントを変更
        Selection.WholeStory
        Selection.Font.Name = fontName
        Selection.Font.Size = fontSize
        
        ' フィールドコートを開く
        Selection.Fields.ToggleShowCodes
        
        ' テキストの置換
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Font.Name = fontName
        With Selection.Find
            .Text = "hps27"
            .Replacement.Text = "hps10"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        
        With Selection.Find
            .Text = "メイリオ"
            .Replacement.Text = "BIZ UDP明朝 Medium"
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        
        With Selection.Find
            .Text = "up 11"
            .Replacement.Text = "up 10"
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        
        ' フィールドコートを閉じる
        Selection.Fields.ToggleShowCodes
        
        ' 行間を設定
    With Selection.ParagraphFormat
        .LeftIndent = MillimetersToPoints(0)
        .RightIndent = MillimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceExactly
        .lineSpacing = 20
        .Alignment = wdAlignParagraphJustify
        .WidowControl = False
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = MillimetersToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
        .CollapsedByDefault = False
        .AutoAdjustRightIndent = True
        .DisableLineHeightGrid = False
        .FarEastLineBreakControl = True
        .WordWrap = True
        .HangingPunctuation = True
        .HalfWidthPunctuationOnTopOfLine = False
        .AddSpaceBetweenFarEastAndAlpha = True
        .AddSpaceBetweenFarEastAndDigit = True
        .BaseLineAlignment = wdBaselineAlignAuto
    End With
        
    Else
        ' キャンセルボタンがクリックされた場合
        Exit Sub
    End If
    
    ' 変換完了のメッセージボックスを表示
    MsgBox "変換完了しました"

End Sub

[マクロについて]

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

---

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