Powerpoint VBA 円を球のように描くマクロ

いつも手動でやっていることをとにかくマクロに書き出してみようとしてみています。

けっこう手間なのに，なぜ手動でちまちまやっていたんだろう・・

特に今回のはコードが極めて短いです。

球体っぽいのを描きたいことが多く，その時に　円のサイズを縦横そろえて，そのサイズをcm単位で見ます。
そして，その半分のサイズを3Dプロパティに入れると球っぽくなる。

今はptとなっていますが，単位のcmまでつけて入力すると，ちゃんとptに自動変換してくれます。

同じサイズならいいですが，違うサイズだといちいち確認していたんです。

今考えると(。´･ω･)?ナゼ　と言いたいところですが，パワーポイントのVBAを使い始めたのはつい最近のことなので，しょうが無いといえばしょうがないです。

今回組んでみたらあまりにもあっさりだったので驚きました。

標準モジュール

Sub 球づくり()
    Dim Shprng As ShapeRange
    Set Shprng = ActiveWindow.Selection.ShapeRange
    
    Dim s As Shape
    For Each s In Shprng
        s.Height = s.Width
        s.ThreeD.BevelTopDepth = s.Width / 2
        s.ThreeD.BevelTopInset = s.Width / 2
    Next
End Sub

これだけ・・

効果はしっかり。

円を選んでおきます。
楕円でも幅に合わせて高さを変えますので，気にしないでいけます。
「球づくり」マクロを実行してください。

お手軽です。

色も変えれますし，球描くのたいへんだよなぁ　めんどうだなーと思われていた方がいたら，いかがでしょう。(ﾟ▽ﾟ*)

今日は細かいのばっかり組んだので，明日からはまじめにやろう。。