Powerpoint VBA 文字を装飾するマクロ - インストールレスプログラミング( ´ー`)

普段，私がパワーポイントで手動でやっていることの第二弾です。

文字を目立たせるために，私は二重縁取りを基本的にします。

文字自身と一度コントラストを確保して，その後もう一度コントラストを確保する。そうすることで，背景に負けずに目立たさせることができると考えています。

やることは単純で，　基本的に私はプレゼンで写真とかに載せる字は黄色を使うんですが，一度黒の６ptで縁取って，さらに１２ptの白で縁取る。

普通にはそういうことはできませんので，３つの図形を重ねる感じです。最後に上下左右に中央ぞろえする。ずれないようにグループ化までします。

あえて少しずらすとかも気分でやります。

これってけっこう面倒なので，マクロのネタにしよう!と思いやってみました。

Shapeindexを取る関数に頼りっきりになるので，今日は頼らずにインデックスを取ってみています。。

さて，コードは次のようになりました。

標準モジュール

Option Explicit
Sub 薄い色とか()
    Call DecoText
End Sub
Sub 濃い色とか()
    Call DecoText(, , vbWhite, vbBlack)
End Sub
Sub カスタム()
    Dim args(0 To 3) As Long
    Dim ret As String
    ret = InputBox(",区切りで引数を入力してください。　太さ1,太さ2,色1,色2", , "6,12,vbblack,vbwhite")
    args(0) = CLng(Split(ret, ",")(0))
    args(1) = CLng(Split(ret, ",")(1))
    Dim tmp As Long, i As Long
    For i = 2 To 3
        tmp = 0
        Select Case Split(ret, ",")(i)
            Case "vbBlack", "vbblack"
                tmp = vbBlack
            Case "vbRed", "vbred"
                tmp = vbRed
            Case "vbGreen", "vbgreen"
                tmp = vbGreen
            Case "vbYellow", "vbyellow"
                tmp = vbYellow
            Case "vbBlue", "vbblue"
                tmp = vbBlue
            Case "vbMagenta", "vbmagenta"
                tmp = vbMagenta
            Case "vbCyan", "vbcyan"
                tmp = vbCyan
            Case "vbWhite", "vbwhite"
                tmp = vbWhite
        End Select
        args(i) = tmp
    Next
    
    Call DecoText(args(0), args(1), args(2), args(3))
End Sub

Sub DecoText(Optional 太さ1 As Long = 6, Optional 太さ2 As Long = 12, _
    Optional 色1 As Long = vbBlack, Optional 色2 As Long = vbWhite)
Dim TargetShape(1 To 3) As Shape
Set TargetShape(1) = ActiveWindow.Selection.ShapeRange(1)
Dim TargetSlide As Slide
Set TargetSlide = ActivePresentation.Slides(TargetShape(1).Parent.SlideIndex)
TargetShape(1).Duplicate
Set TargetShape(2) = TargetSlide.Shapes(TargetSlide.Shapes.Count)
With TargetShape(2)
    .TextFrame2.TextRange.Font.Line.Weight = 太さ1
    .TextFrame2.TextRange.Font.Line.ForeColor.RGB = 色1
End With
TargetShape(1).Duplicate

Set TargetShape(3) = TargetSlide.Shapes(TargetSlide.Shapes.Count)
With TargetShape(3)
    .TextFrame2.TextRange.Font.Line.Weight = 太さ2
    .TextFrame2.TextRange.Font.Line.ForeColor.RGB = 色2
    TargetShape(2).ZOrder msoBringToFront
    TargetShape(1).ZOrder msoBringToFront
End With
Dim s As Shape
Dim i As Long, j As Long, Indexes As Variant
ReDim Indexes(1 To 3) As Long
For j = 1 To 3
    i = 1
    For Each s In TargetSlide.Shapes
        If s Is TargetShape(j) Then
            Indexes(j) = i
            Exit For
        End If
        i = i + 1
    Next
Next

With TargetSlide.Shapes.Range(Indexes)
    .Align msoAlignCenters, msoFalse
    .Align msoAlignMiddles, msoFalse
    .Group
End With

End Sub