Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

63387 / 76732

←次へ　｜　前へ→


	【17941】Re:３次元棒グラフをマクロで描くには

ichinose - 04/9/10(金) 18:24 -


	引用なし

	パスワード

▼カドさん：
こんばんは。

>３次元の棒グラフをマクロで描きたいのですが、下記のマクロを実施すると、
>棒の右側面の大きさが合いません。
>
>どうすればよいか教えてください。
Adjustmentsオブジェクトの位置によって工夫しなければならないみたいですね！！

以下のコードを試してみて下さい。
'=========================================================
Sub Macro30()
'（ｘ位置、ｙ位置、幅、長さ）

　　Call set_fund_shp(ActiveSheet.Shapes.AddShape(msoShapeCube, 50, 80, 15, 20))
　　Call set_adj(ActiveSheet.Shapes.AddShape(msoShapeCube, 50, 70 + 4, 15, 10))
End Sub

上記とは違う標準モジュールに
'=================================================================
　 Dim f_sz As Double 'widthとheightの小さい方のサイズ
　 Dim adj As Double '調整値
　 Dim l_u As Long '0:上端　1:左端
Sub set_fund_shp(shp As Shape)
　 With shp
　　 If .Height <= .Width Then
　　　　l_u = 0
　　　　f_sz = .Height
　　 Else
　　　　l_u = 1
　　　　f_sz = .Width
　　　　End If
　　 adj = .Adjustments.Item(1)
　　 End With
End Sub
'=====================================================================
Sub set_adj(shp As Shape)
　 Dim s_l_u As Long
　 Dim s_sz As Double
　 With shp
　　 If .Height <= .Width Then
　　　　s_l_u = 0
　　　　 s_sz = .Height
　　 Else
　　　　s_l_u = 1
　　　　s_sz = .Width
　　　　End If
　　 If l_u <> s_l_u Then
　　　　.Adjustments.Item(1) = f_sz * adj / s_sz
　　　　End If
　　 End With
End Sub

もっともWidthが大きくなると（１００とか２００）他の事も考えなければなりませんが・・・。

取り合えず、確認してみて下さい。

1 hits

▼

【17918】３次元棒グラフをマクロで描くには カド 04/9/10(金) 12:32