シェイプ影付与 

シェイプ影付与 version1.0

ホットキーに割り当てると使いやすい。
枠シェイプを除いたすべてのシェイプに影を付与する。

'シェイプに影をつける
Sub castShadowWithAllShape()

    '実行前の選択セル範囲を取得(最後にここに選択状態を戻すため)
    Dim beforeCellAddress As String: beforeCellAddress = Selection.Address
    
    Dim shp As shape
    For Each shp In ActiveSheet.Shapes
        shp.Select Replace:=False
        '枠シェイプは除外する
        If Selection.ShapeRange.Type = 13 Then
            With Selection.ShapeRange.Shadow
                '影の種類
                .Type = msoShadow25
                '影の表示切替
                .Visible = msoTrue
                .Style = msoShadowStyleOuterShadow
                'ブロアー。影のぼかし具合
                .Blur = 23
                '影の相対位置
                .OffsetX = 7.7781745931
                .OffsetY = 7.7781745931
                '影をシェイプとともに回転させるかどうか
                .RotateWithShape = msoFalse
                '影の色
                .ForeColor.RGB = RGB(0, 0, 0)
                'トランスパレンシー。影の透明度
                .Transparency = 0.3500000238
                '影のサイズ
                .Size = 100
            End With
        End If
        
        'シェイプセレクトの解除
        Range(beforeCellAddress).Select
    Next
End Sub


コメント