便利なマクロ集 - 株式会社グローバルアイティー

TeraMacroとかPythonでは無く、MSオフィスのマクロ集です。（GPT4に書いて貰ったものを含みます。）

Wordで、フォントとサイズを英語、日本語、数値でそれぞれ別のものに統一する。

Sub ReplaceFonts()
Dim doc As Document
Dim rng As Range
Dim i As Integer
Set doc = ActiveDocument

' 日本語の文字列のフォントとサイズを置換
For i = 1 To Len(doc.Range.Text)
    Set rng = doc.Range.Characters(i)
    If IsJapanese(rng.Text) Then
        rng.Font.Name = "明朝体"
        rng.Font.Size = 5
    End If
Next i

' 英語の文字列のフォントとサイズを置換
For i = 1 To Len(doc.Range.Text)
    Set rng = doc.Range.Characters(i)
    If IsEnglish(rng.Text) Then
        rng.Font.Name = "MS ゴシック"
        rng.Font.Size = 5
    End If
Next i

' 数値のフォントとサイズを置換
For i = 1 To Len(doc.Range.Text)
    Set rng = doc.Range.Characters(i)
    If IsNumeric(rng.Text) Then
        rng.Font.Name = "Meiryo UI"
        rng.Font.Size = 5
    End If
Next i

End Sub

Function IsJapanese(char As String) As Boolean
‘ 日本語判定（ユニコード範囲による簡易判定）
IsJapanese = (AscW(char) >= &H3040 And AscW(char) <= &H30FF) Or _ (AscW(char) >= &H4E00 And AscW(char) <= &H9FAF) Or _ (AscW(char) >= &HFF66 And AscW(char) <= &HFF9D)
End Function

Function IsEnglish(char As String) As Boolean
‘ 英語判定（ASCIIコード範囲による簡易判定）
IsEnglish = (AscW(char) >= 65 And AscW(char) <= 90) Or _ (AscW(char) >= 97 And AscW(char) <= 122)
End Function

エクセルで一度に500個の置換を行う（そう言えばワードやパワポでも同じこと出来ると便利ですね）

※500までと言う制限は、コードを「親子化」等すると増やせます。
※下記のコードは1個分の置換しか書いていませんが、ちょっとした工夫でカンタンに500個分書けます。ヒントは「エクセルの表でエクセルのマクロを書く」です。日常的にコンフィグ書いている人なら知っているテクニックだと思います。

Cells.Replace What:=”置換前①”, Replacement:=”置換後①”, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

パワーポイントで障害ポイント図を作成する（「星形オブジェクトに数字を載せたもの」の番号が抜けたり飛んだりした事ありませんか？）

※「番号の飛びの無い星形オブジェクト」をマクロで生成し、カット＆ペーストで図に載せれば番号の抜け飛びが発生しません。

Sub CreateStarShapes()
Dim slide As slide
Dim shape As shape
Dim i As Integer
Dim xPos As Single
Dim yPos As Single
Dim size As Single

' 初期位置とサイズ
xPos = 100
yPos = 100
size = 32

' アクティブなスライドを取得
Set slide = ActivePresentation.Slides(1)

' 20個の星形を作成
For i = 1 To 20
    ' 星形を追加
    Set shape = slide.Shapes.AddShape(msoShape16pointStar, xPos, yPos, size, size)

    ' 枠線と塗りつぶしの設定
    With shape
        .Line.ForeColor.RGB = RGB(255, 0, 0) ' 赤色の枠線
        .Fill.ForeColor.RGB = RGB(255, 0, 0) ' 赤色の塗りつぶし

        ' 内部のテキスト設定
        With .TextFrame.TextRange
            .Text = ChrW(&H2460 + (i - 1)) ' ①からの番号付け
            .Font.size = 14 ' フォントサイズ
            .Font.Color = RGB(255, 255, 255) ' 白色の文字
        End With
    End With

    ' 位置の更新
    xPos = xPos + 5
    yPos = yPos + 5
Next i

End Sub

関連投稿: