t-hom’s diary

主にVBAネタを扱っているブログです。

VBA 角丸四角形の角の丸めサイズを統一するマクロ(Excel・PowePoint・Word対応)

角丸シェイプは普通の四角形に比べて柔らかい印象を与えるため、よく使用される。

しかし普通に配置すると、シェイプのサイズによって角丸のサイズも拡大・縮小するため、丸めサイズが不揃いで格好悪い。
f:id:t-hom:20180611080918p:plain

諦めているか、目視で微調整している方がほとんどだと思うけれど、できることなら数値指定でバシッと揃えたい。

ということでマクロの紹介。
角丸シェイプを複数選択した状態でこのマクロを実行すると、角の丸めサイズがきっちり揃う。

Sub AdjustRoundedRectangle()
    '選択中の角丸四角形の角を指定のサイズで丸めるマクロです。
    'ROUND_SIZEに5~20程度の整数を入れて試してみてください。
    'Excel・Word・PowerPontで使用できます。
    'ただしWordのキャンバス内のシェイプには対応していません。
    Const ROUND_SIZE = 10
    Dim sh As Shape
    '↓ActiveWindowはPowerPoint対応のために明示的に記載が必要。
    For Each sh In ActiveWindow.Selection.ShapeRange
        Dim shortEdge As Single
        '角丸のサイズは短辺を基に算出される為、shortEdgeを判定する。
        shortEdge = IIf(sh.Width < sh.Height, sh.Width, sh.Height)
        sh.Adjustments.Item(1) = ROUND_SIZE / shortEdge
    Next
End Sub

f:id:t-hom:20180611081528p:plain

丸めサイズの指定はROUND_SIZE定数を変更することで可能。

ただこのマクロは残念なことにWordのキャンバス内のシェイプには対応していない。
そこでキャンバス専用のマクロも用意した。

Sub AdjustRoundedRectangleForWordCanvas()
    '選択されたWordキャンバスに存在するすべての角丸四角形の角を
    '指定のサイズで丸めるマクロです。個別のシェイプ選択には対応していません。
    'ROUND_SIZEに5~20程度の整数を入れて試してみてください。
    Const ROUND_SIZE = 5
    Dim sh As Shape
    For Each sh In Selection.ShapeRange(1).CanvasItems
        If TypeName(sh) = "Shape" Then
            If sh.AutoShapeType = msoShapeRoundedRectangle Then
                Dim shortEdge As Single
                shortEdge = IIf(sh.Width < sh.Height, sh.Width, sh.Height)
                sh.Adjustments.Item(1) = ROUND_SIZE / shortEdge
            End If
        End If
    Next
End Sub

キャンバスに存在する角丸四角形を一つ選択して実行すると、そのキャンバス内のすべての角丸四角形が丸められる。
※これはキャンバス内の選択状態を拾う方法が分からなかった為。

以上

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。