Home > Excel VBA | GraphControl > Excel 3Dグラフの奥行設定(3D Chart Perspective)

Excel 3Dグラフの奥行設定(3D Chart Perspective)

Posted by: WebMaster
2008年4月17日 08:49
Excel VBA | GraphControl

エクセル３Ｄグラフの奥行きを設定するマクロを紹介します。

Excel VBA source code which set the value perspective of 3D Chart.

以下のコードは3Dグラフの奥行きの値を10 アップさせます。奥行きの範囲は0～100ですので、範囲外のケースでイグジットします。.Perspective のデータ型に合わせて変数 Perspective を Long で宣言してます。(Perspective as long も Perspective& も同じです。) 3Dグラフの壁面または床面を一旦select します。変数 Perspective に指定したグラフの現在の奥行きの値を格納します。そして１０を足して設定します。

The code below is to increase perspective of chart by 10. Store the value of activechart.Perspective to var Perspective which is declared as long. The range of perspective is from 0 to 100, so that in case the elevation+10 exceed 100, exit sub.

GraphControl で使用しているコードです。

the code below is used in GraphControl.

''---------------------------------------------------------------
''-------------奥行きの値を高くする--------------
''-------------------------------------------------------------
Private Sub Com_Perspective1_Click()
If NumChart = 0 Then Exit Sub  ''-if the number of charts on selected sheet=0 then exit sub
On Error Resume Next
Dim Perspective&

Application.ScreenUpdating = False
If CheckBox4.Value = True Then
 Temp1 = 1: Temp2 = NumChart
Else
 Temp1 = ChartObject: Temp2 = ChartObject
End If

For ChartObject = Temp1 To Temp2
   ActiveSheet.ChartObjects(ChartObject).Activate
   With ActiveChart
    .Walls.Select
    .RightAngleAxes = False ''---RightAngleAxes has to be false to change perspective
    
    Perspective = .Perspective
    If Perspective >= 100 Then Exit For   ''---in case limit is exceeded, exit loop
    
    .Perspective = Perspective + CInt(TextBox42.Value)
   End With
 Next
 
If CheckBox4.Value = False Then
 Label3d3_1.Caption = "Chart:" & CStr(TextBox30.Value)
 Label3d3_2.Caption = "奥行:" & Perspective
 DoEvents
Else
 Label3d3_1.Caption = "Chart:all"
 Label3d3_2.Caption = ""
 DoEvents
End If
ChartObject = CInt(TextBox30.Value)
Application.ScreenUpdating = True
End Sub

''--------------------------------------------------------------------------------
''-----------奥行の値を低くする--------------------------------------------
''--------------------------------------------------------------------------------

Private Sub Com_Perspective2_Click()
If NumChart = 0 Then Exit Sub
On Error Resume Next
Dim Perspective&

Application.ScreenUpdating = False
If CheckBox4.Value = True Then
 Temp1 = 1: Temp2 = NumChart
Else
 Temp1 = ChartObject: Temp2 = ChartObject
End If

For ChartObject = Temp1 To Temp2
   ActiveSheet.ChartObjects(ChartObject).Activate
   With ActiveChart
    .Walls.Select
    .RightAngleAxes = False
    
    Perspective = .Perspective
    If Perspective <= 0 Then Exit For
    
    .Perspective = Perspective - CInt(TextBox42.Value)
   End With
 Next
 
If CheckBox4.Value = False Then
 Label3d3_1.Caption = "Chart:" & CStr(TextBox30.Value)
 Label3d3_2.Caption = "奥行:" & Perspective
 DoEvents
Else
 Label3d3_1.Caption = "Chart:all"
 Label3d3_2.Caption = ""
 DoEvents
End If

ChartObject = CInt(TextBox30.Value)
Application.ScreenUpdating = True
End Sub

Comments:0

Amazon.co.jp ウィジェット

Home > Excel VBA | GraphControl > Excel 3Dグラフの奥行設定(3D Chart Perspective)

Return to page top