二重下線で挟む・黒地白抜き・グレー地・下線・点線の四角【素人 Word マクロ】

Microsoft officeのWordVBAでマクロを組みましたので公開します。
インターネットで検索したり、マクロの記録機能を使ったり、AIに考えてもらったりしたのを組み合わせだけなので、上手くはないですが、一応動くはずです。
office2021です。
必ず、元データのバックアップを取ってから実行してください。
素人の作ったものなので、信用しすぎないでください。

[仕様]
カーソルをおいた行を加工します。
タイトル・セクションタイトル用に作りました。

[コード]

Sub タイトル加工()
    Dim choice As Integer
    Dim currentLine As Range
    Dim inputRange As Range
    
    ' カーソルのある行を取得
    Set inputRange = Selection.Paragraphs(1).Range
    inputRange.Select
    
    ' ユーザーにオプションを選択させる
    choice = InputBox("次の選択肢から選んでください:" & vbCrLf & _
                      "1 二重線で挟む" & vbCrLf & _
                      "2 黒地白抜き化" & vbCrLf & _
                      "3 グレー地黒字" & vbCrLf & _
                      "4 下線" & vbCrLf & _
                      "5 点線で囲む", "選択肢を入力")

    Select Case choice
        Case 1
            ' 二重線で挟む
            With inputRange
                .Font.Size = 20
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
                .Borders(wdBorderTop).LineStyle = wdLineStyleDouble
                .Borders(wdBorderTop).LineWidth = wdLineWidth075pt
                .Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
                .Borders(wdBorderBottom).LineWidth = wdLineWidth075pt
            End With
        Case 2
            ' 黒地白抜き化
            With inputRange
                .Font.Size = 16
                .Font.Color = wdColorWhite
                .Shading.BackgroundPatternColor = wdColorBlack
            End With
        Case 3
            ' グレー地黒字
            With inputRange
                .Font.Size = 16
                .Font.Color = wdColorBlack
                .Shading.BackgroundPatternColor = wdColorGray25
            End With
        Case 4
            ' 下線
            Selection.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
            Selection.ParagraphFormat.Borders(wdBorderBottom).LineWidth = wdLineWidth025pt
        Case 5
            ' 点線で囲む
            With inputRange
                .Borders(wdBorderTop).LineStyle = wdLineStyleDot
                .Borders(wdBorderBottom).LineStyle = wdLineStyleDot
                .Borders(wdBorderLeft).LineStyle = wdLineStyleDot
                .Borders(wdBorderRight).LineStyle = wdLineStyleDot
            End With
        Case Else
            MsgBox "無効な選択です。1から5の数字を入力してください。"
    End Select
End Sub

いいなと思ったら応援しよう!