現在、エクセルで、選択したグラフの大きさや縦横軸を統一するマクロを作成

質問

現在、エクセルで、選択したグラフの大きさや縦横軸を統一するマクロを作成中です。

以下のようなマクロまでは作ることができましたが、ひとつだけ不満があります。

それは、初期値です。
できれば、最初に選択したグラフの設定を初期としてダイアログの入力欄に記入してある状態にしたいのですが、どうすればよいかわかりません。

知恵を貸してください！！

よろしくお願いいたします！！！

Sub 選択したグラフ縦横軸変更()
Dim chartObj As ChartObject
Dim myObj As Object
Dim xmin As Double
Dim xmax As Double
Dim ymin As Double
Dim ymax As Double

xmin = Application.InputBox("x軸最小値")
xmax = Application.InputBox("x軸最大値")
ymin = Application.InputBox("y軸最小値")
ymax = Application.InputBox("y軸最大値")

For Each myObj In Selection
Set chartObj = ActiveSheet.ChartObjects(myObj.Name)

With chartObj.Chart.Axes(xlCategory)
.MaximumScale = xmax
.MinimumScale = xmin
End With

With chartObj.Chart.Axes(xlValue)
.MaximumScale = ymax
.MinimumScale = ymin
End With
Next myObj
End Sub

回答No.1

end-u · ベストアンサー

Sub try()
　　Dim objs As Object
　　Dim obj　As Object
　　Dim flg　As Boolean
　　Dim xmin As Double
　　Dim xmax As Double
　　Dim ymin As Double
　　Dim ymax As Double

　　If TypeName(Selection) <> "DrawingObjects" Then
　　　　MsgBox "failure"
　　　　Exit Sub
　　End If

　　Set objs = Selection
　　For Each obj In objs
　　　　If TypeName(obj) = "ChartObject" Then
　　　　　　flg = True
　　　　　　With obj.Chart
　　　　　　　　With .Axes(xlCategory)
　　　　　　　　　　xmin = .MinimumScale
　　　　　　　　　　xmax = .MaximumScale
　　　　　　　　End With
　　　　　　　　With .Axes(xlValue)
　　　　　　　　　　ymin = .MinimumScale
　　　　　　　　　　ymax = .MaximumScale
　　　　　　　　End With
　　　　　　End With
　　　　　　Exit For
　　　　End If
　　Next
　　If flg Then
　　　　xmin = Application.InputBox("x軸最小値", , xmin)
　　　　xmax = Application.InputBox("x軸最大値", , xmax)
　　　　ymin = Application.InputBox("y軸最小値", , ymin)
　　　　ymax = Application.InputBox("y軸最大値", , ymax)
　　　　For Each obj In objs
　　　　　　If TypeName(obj) = "ChartObject" Then
　　　　　　　　With obj.Chart
　　　　　　　　　　With .Axes(xlCategory)
　　　　　　　　　　　　.MinimumScale = xmin
　　　　　　　　　　　　.MaximumScale = xmax
　　　　　　　　　　End With
　　　　　　　　　　With .Axes(xlValue)
　　　　　　　　　　　　.MinimumScale = ymin
　　　　　　　　　　　　.MaximumScale = ymax
　　　　　　　　　　End With
　　　　　　　　End With
　　　　　　End If
　　　　Next
　　End If

　　Set objs = Nothing
End Sub

こんな感じです。

2003以前と2007でちょっと挙動が違って、
2003では上記try実行した後、Selctionのまま再実行すると
最初に選択したChartがわからなくなるようです。
単独で実行する分には問題ないでしょう。

お礼

ありがとうございます！！これで効率化します！！