| 
    
     |  | ▼カド さん: こんばんは。
 
 >3次元の棒グラフをマクロで描きたいのですが、下記のマクロを実施すると、
 >棒の右側面の大きさが合いません。
 >
 >どうすればよいか教えてください。
 Adjustmentsオブジェクトの位置によって工夫しなければならないみたいですね!!
 
 以下のコードを試してみて下さい。
 '=========================================================
 Sub Macro30()
 '(x位置、y位置、幅、長さ)
 
 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が大きくなると(100とか200)他の事も考えなければなりませんが・・・。
 
 取り合えず、確認してみて下さい。
 
 |  |