Power Pointを使って平面画像から立体画像を作る（VBAコード付き）

この記事は2020年12月15日に加筆・修正しました

動作環境

Windows 10
Office Home and Business 2019

図形の書式設定→3-D書式→奥行き→サイズ 40pt

図形の書式設定→3-D回転→X方向に回転→20°

図形の書式設定→3-D回転→Y方向に回転→20°

元の平面画像

立体画像

VBAコード

With ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRoundedRectangle, 0, 120, 64, 126)
    .Adjustments.Item(1) = 0.2
    .Line.Visible = msoFalse
    .Select Replace:=msoTure
End With

With ActiveWindow.Selection.ShapeRange
    .Align msoAlignCenters, msoTrue
    .Name = "img1"
End With

With ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRoundedRectangle, 0, 238, 78, 42)
    .Adjustments.Item(1) = 0.35
    .Line.Visible = msoFalse
    .Select Replace:=msoTrue
End With

With ActiveWindow.Selection.ShapeRange
    .Align msoAlignCenters, msoTrue
    .Name = "img2"
End With

With ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, 0, 255, 78, 30)
    .Line.Visible = msoFalse
    .Select Replace:=msoTrue
End With

With ActiveWindow.Selection.ShapeRange
    .Align msoAlignCenters, msoTrue
    .Name = "img3"
End With

ActivePresentation.Slides(1).Shapes.Range(Array("img1", "img2", "img3")).Select

With ActiveWindow.Selection.ShapeRange
    .MergeShapes msoMergeUnion
    .Fill.ForeColor.RGB = RGB(191, 191, 191)
    .Line.Visible = msoTrue
    .Line.ForeColor.RGB = RGB(0, 0, 0)
    .Select
End With

With ActiveWindow.Selection.ShapeRange
    .Name = "img4"
End With

'3-D回転と3-D書式奥行きの設定
With ActivePresentation.Slides(1).Shapes("img4").ThreeD
    .RotationX = -20 'なぜかマイナスをつけて指定
    .RotationY = 20
    .Depth = 40
End With