Excel VBA 図形(シェイプ)で球体を作成する

スポンサーリンク

図形(シェイプ)で球体を作成する方法

オートシェイプの楕円に、3D効果の面取りと光源を設定して球体に見えるシェイプを作成します。

実行イメージ


球体の直径をセンチ単位で入力します。ここでは4センチを設定しました。



球体の数量を入力します。ここでは10個を設定しました。



10個連なって球体が作成されました。



指定した大きさと数量の球体に見えるシェイプを作成するコードと解説

Sub 球体()
Dim センチ As Double
Dim ポイント As Double
Dim 数量 As Long
Dim i As Long
Dim 位置 As Range
センチ = Application.InputBox("球体の直径をセンチ単位で入力してください。", Type:=1)
ポイント = Application.CentimetersToPoints(センチ)
数量 = Application.InputBox("作成する球体の数量を入力してください。", Type:=1)
For i = 1 To 数量
Set 位置 = Cells(i + 1, 3)
On Error GoTo エラー処理
With ActiveSheet.Shapes.AddShape(9, 位置.Left, 位置.Top, ポイント, ポイント)
   With .ThreeD
           .BevelTopType = 3
           .BevelTopDepth = ポイント / 2
           .BevelTopInset = ポイント / 2
           .BevelBottomType = 3
           .BevelBottomDepth = ポイント / 2
           .BevelBottomInset = ポイント / 2
           .PresetLighting = 15
    End With
       .Line.Visible = False
End With
Next i
Exit Sub
エラー処理:
      MsgBox "入力された数値が境界を超えています。処理を終了します。"
End Sub
2行目【Dim センチ As Single】
インプットボックスでユーザーから受け取る球体の直径の値を格納する変数「センチ」を倍精度浮動小数点型 (Double)で宣言します。


3行目【Dim ポイント As Single】
インプットボックスでユーザーから受け取った球体の直径を表す値をセンチメートルからポイントに変換した値を格納する変数「ポイント」を倍精度浮動小数点型 (Double)で宣言します。


4行目【Dim 数量 As Long】
インプットボックスでユーザーから受け取る球体を作成する数量を格納する変数「数量」を長整数型(Long)で宣言します。


5行目【Dim 位置 As Range】
球体を作成する位置の基準となるセルを格納する変数「位置」をオブジェクト型(Range)で宣言します。


6行目【センチ = Application.InputBox(“球体の直径をセンチ単位で入力してください。”, Type:=1)】
Application【アプリケーション】オブジェクトのInputBox【インプットボックス】メソッドを使用して、ユーザーに球体の直径をセンチメートル単位で入力してもらい受け取った値を変数「センチ」に代入します。数値のみ受け取るので引数Typeには1を設定します。


7行目【ポイント = Application.CentimetersToPoints(センチ)】
Application【アプリケーション】オブジェクトのCentimetersToPoints【センチメーターズトゥポインツ】メソッドを使用して、ユーザーから受け取った球体の直径を表す値の単位をセンチメートルからポイントに変換して変数「ポイント」に格納します。


8行目【数量 = Application.InputBox(“作成する球体の数量を入力してください。”, Type:=1)】
Application【アプリケーション】オブジェクトのInputBox【インプットボックス】メソッドを使用してユーザーに作成する球体の数量を入力してもらい受け取った値を変数「数量」に代入します。数値のみ受け取るので引数Typeには1を設定します。


9行目【For i = 1 To 数量】
For Next【フォアネクスト】ステートメントを使用して、繰り返し処理の始まりです。1~変数「数量」の値を順次カウンター変数iに代入します。変数「数量」に格納されている値が繰り返し回数になります。


10行目【Set 位置 = Cells(i + 1, 3)】
図形を作成する位置の基準となるセルをオブジェクト変数「位置」にSetキーワードを使用して代入します。i行+1行の3列のセルつまり、C列の2行目のセルからi行目までが順次オブジェクト変数「位置」に代入されます。


11行目【On Error GoTo エラー処理】
InputBox【インプットボックス】メソッドでユーザーから受け取る値がシートの大きさを超えていたり、倍精度浮動小数点型 (Double)の範囲を超えている場合はエラーが発生してディバックモードになってしまうのでそれを避けるためOn Error【オンエラー】ステートメントとGoTo【ゴォトゥ】ステートメントを使用してエラーが発生したらエラー処理のラベル(27行目)まで処理をジャンプさせてデバックモードを回避します。


12行目【With ActiveSheet.Shapes.AddShape(9, 位置.Left, 位置.Top, ポイント, ポイント)】
Worksheet【ワークシート】オブジェクトの、図形の集まりを表すShapes【シェイプスコレクション】のAddShape【アドシェイプ】メソッドを使用して図形を作成して、With【ウィズ】ステートメントで指定します。

作成する図形の種類を指定する第一引数のTypeには楕円を表す値の9を指定します。


13行目【With .ThreeD】
with【ウィズ】ステートメントで指定したAddShape【アドシェイプ】メソッドで作成した図形を表す、Shape【シェイプ】オブジェクトのThreeD【スリーディ】プロパティを使用して、立体の書式設定を表すThreeDFormat【スリーディフォーマット】オブジェクトを取得して、さらにWith【ウィズ】ステートメントで指定します。


14行目【.BevelTopType = 3】
With【ウィズ】ステートメントで指定した立体の書式を表す、ThreeDFormat【スリーディフォーマット】オブジェクトの図形の表面の面取りの種類を設定するBevelTopType【ベベルトップタイプ】プロパティに円形を表す値3を設定します。


15行目【 .BevelTopDepth = ポイント / 2】
With【ウィズ】ステートメントで指定した立体の書式を表す、ThreeDFormat【スリーディフォーマット】オブジェクトの図形の表面の面取りの幅を設定するBevelTopDepth【ベベルトップディプス】プロパティに変数「ポイント」に格納されている値の半分の値を設定します。つまり図形の直径の半分の値を代入することになります。


16行目【.BevelTopInset = ポイント / 2】
With【ウィズ】ステートメントで指定した立体の書式を表す、ThreeDFormat【スリーディフォーマット】オブジェクトの図形の表面の面取りの高さを設定するBevelTopInset【ベベルトップインセット】プロパティに変数「ポイント」に格納されている値の半分の値を設定します。つまり図形の直径の半分の値を代入することになります。


17行目~19行目【 .BevelBottomType = 3
.BevelBottomDepth = ポイント / 2
.BevelBottomInset = ポイント / 2】

図形の裏面の面取りの設定になります。内容は14行目~16行目の図形の表面の面取りの設定と同じです。


20行目【.PresetLighting = 15】
With【ウィズ】ステートメントで指定した立体の書式を表す、ThreeDFormat【スリーディフォーマット】オブジェクトの
光源の種類を設定するPresetLighting【プリセットライティング】プロパティに「ソフト効果」を表す値の15を設定します。


22行目【.Line.Visible = False】
最初のWith【ウィズ】ステートメントで指定したAddShape【アドシェイプ】メソッドで取得した、図形を表すShape【シェイプ】オブジェクトのLine【ライン】プロパティを使用して線の書式設定を表すLineFormat【ラインフォーマット】オブジェクトを取得して、LineFormat【ラインフォーマット】オブジェクトのVisible【ビジブル】プロパティにFalseを設定して図形の枠線を非表示に設定します。


25行目【Exit Sub】
エラーが発生せずに処理が行われた場合はExit【エクジット】ステートメントを使用してSub【サブ】プロシージャを終了します。


26行目~27行目【エラー処理:
MsgBox “入力された数値が境界を超えています。処理を終了します。”】

エラーが発生した場合はエラーでデバックモードにならないように26行目の「エラー処理」ラベルまで処理がシャンプして
MsgBox【メッセージボックス】関数を使用してユーザーにメッセージを表示します。


作成した図形を透過画像(png)として保存する場合は、「作成した図を透過画像ファイル(PNG)で書き出す」をご覧ください。


以上で、図形(シェイプ)で球体を作成する方法についての解説を終了します。ありがとうございました。

スポンサーリンク

関連記事・広告