青空文庫Word変換【素人 Word マクロ】
Microsoft officeのWordVBAでマクロを組みましたので公開します。
インターネットで検索したり、マクロの記録機能を使ったりしたのを組み合わせだけなので、上手くはないですが、一応動くはずです。
office2021です。
必ず、元データのバックアップを取ってから実行してください。
素人の作ったものなので、信用しすぎないでください。
[内容]
青空文庫のHTML表示をコピーして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
[マクロについて]
ファイルタブ→その他→オプション→ユーザーのリボン設定→開発タブを追加、でマクロが導入できます。検索してください。
素人の作ったものなので、信用しすぎないでください。
この記事が気に入ったらサポートをしてみませんか?