Excelマクロ・グラフエリア・プロットエリアのサイズを変更及び綺麗に並べる

質問

何方か、宜しくお願いします。

質問1
ワークシート上の複数のグラフを選択した状態でマクロを実効して
全てのグラフエリア・プロットエリアを同じサイズに変更するマクロを
教えて下さい。
（下記のコードでは、一つのグラフのプロットエリアのみ変更になります。）

Sub グラフサイズ()
ActiveSheet.ChartObjects("グラフ 1").Activate
ActiveChart.PlotArea.Select 'プロットエリア
With Selection
.Top = 17
.Left = 27
.Width = 463
.Height = 330
End With
Range("A3").Select
End Sub
（参考：http://oshiete.nikkeibp.co.jp/qa780484.html）

質問2
質問1で修正したグラフを3列、行数は任意でワークシート上に綺麗に並べたい
のですが、どのようなコードでしょうか。？（グラフとグラフの間は5ポイント位
隙間を入れたいと思います。グラフ数は20～40位、Excel2000）

回答No.6

Wendy02 · ベストアンサー

こんばんは。Wendy02です。

>プロットエリアサイズは固定出来ないのでしょうか？、私が探した所無いようでしたが？Excelの仕様かな？

ある程度は可能ですが、On Error トラップが必要ですね。つまり、そのまま実行してしまうと、物理的？な数値に合わないと、実行時エラーが発生してしまうのです。だいたい、プロットエリアの大きさは、グラフエリアの90%ぐらいだったかな？　だから、理論的に、一旦、プロットエリアの大きさを取って、グラフエリアを変更してしまえば可能だと思うのです。その後で、並びの位置整理すればよいわけですね。でも、そうすると、今度は、グラフ全体の大きさがマチマチになる可能性があるわけです。

それで、最初の私のコードのように、グラフエリアは、余計なものだとして、私は、消してしまったのです。結構、見栄えが良いなって、自負したのですが……。^^;

お礼

回答ありがとう御座いました。
今回もいろいろ勉強になりました。

回答No.5

Wendy02

こんばんは。Wendy02です。

分かっていらっしゃると思いますが、こちらのマクロを使えば、プロットエリア側のマクロは、有効な値を入れない限りは、その値は無効になります。

Sub ChrtAreaSizing()
Dim chrt As ChartObject
　For Each chrt In ActiveSheet.ChartObjects　'埋め込みグラフ
　　With chrt 'グラフエリア
　　　.Width = 330　 'ユーザーの任意の値
　　　.Height = 200
　　End With
　 Next chrt
End Sub

お礼

Wendy02様、他の回答者の皆様ありがとう御座いました。
プロットエリアサイズが自動で変わることで少し戸惑いましたが
グラフエリアサイズを先に変更した後プロットエリアサイズを変更
して何とか上手くいきました、今回はありがとう御座いました。
（プロットエリアサイズは固定出来ないのでしょうか？、私が探した所
無いようでしたが？Excelの仕様かな？）

回答No.4

Wendy02

こんにちは。Wendy02です。

そうでしたか!　すみません。ちょっとレイアウトにこだわってしまったもので。

>例えば、10個のグラフが有ったとして全てのグラフエリアが同じで
>プロットエリアはグラフエリアよりも小さいサイズで10個同じという意味です。

それは訂正したものを新たに出しますが、でも、#3のTestGraphArrangement　は、悪くない感じです。印刷プレビューでみると分かります。ただし、一回消えたものは、Ctrl + Z では戻りませんので、バックアップが必要です。

以下は、プロットエリアだけのサイジングをします。

Sub GraphSizing() 'グラフサイズ
Dim chrt As ChartObject
　For Each chrt In ActiveSheet.ChartObjects　'埋め込みグラフ
　　With chrt.Chart.PlotArea 'プロットエリア
　　　.Width = 463　　'ユーザーの任意の値
　　　.Height = 330　' ''
　　End With
　 Next chrt
End Sub

補足

Wendy02様宜しければ教えて下さい。
下記のマクロだとプロットエリアサイズのみ変更ですが
グラフエリアのサイズも変更したいのですが。。。。
宜しければコードを教え下さい。

Sub GraphSizing()
Dim chrt As ChartObject
　For Each chrt In ActiveSheet.ChartObjects　'埋め込みグラフ
　　With chrt.Chart.PlotArea 'プロットエリア
　　　.Width = 463　　'ユーザーの任意の値
　　　.Height = 330　' ''
　　End With
　 Next chrt
End Sub

回答No.3

Wendy02

#2の追伸です。

今、試してみたけれども、以下のように、凡例だけ消してあげるだけでも、よさそうな気がします。
解説をつけておきましたので、必要に応じて、ブロックアウト（「'（アポストロフィ)をつける」)してください。なお、プロットサイズとグラフエリアは、同じにならない、ということを前提としています。

Sub TestGraphArrangement()
'グラフエリアとプロットエリアの差を近づける
Dim grph As ChartObject
　On Error Resume Next
　For Each grph In ActiveSheet.ChartObjects
　　With grph.Chart
　　　'.Axes(xlValue).Delete　'数値軸
　　　'.Axes(xlCategory).Delete　'項目軸
　　　.Legend.Delete 　'凡例
　　　.ChartArea.Border.LineStyle = 0　'グラフエリアの外周線を消す
　　　.ChartArea.Interior.ColorIndex = xlNone 'グラフエリアを透明にする
　　End With
　Next
End Sub

#2の訂正です。
>その横並びの一番大きな高さのものを対象にして
を忠実に表してはいませんでした。横並びの一番高い高さを確保しても、3列終わったら、一度、0にしてあげないといけませんでした。

Dim StartPos As Range
　Set StartPos = Range("D2") '最初のグラフのトップの位置
　sngTop = StartPos.Top
　sngLeft = StartPos.Left
　For Each grph In ActiveSheet.ChartObjects
　i = i + 1
　　With grph
　　.Top = sngTop
　　　 .Top = sngTop
　　　 .Left = sngLeft + sngWidth + 5 '横は、5ポイント
　　　　sngWidth = sngWidth + .Chart.ChartArea.Width
　　　　If .Chart.ChartArea.Height > sngHeight Then
　　　　　 sngHeight = .Chart.ChartArea.Height
　　　　End If
　　 If i Mod 3 = 0 Then
　　　 sngTop = sngTop + sngHeight + 5　'縦の間は、5ポイント
　　　 sngHeight = 0　'加入
　　　 sngWidth = 0
　　 End If
　　End With
　Next
End Sub

お礼

Wendy02様何時も回答ありがとう御座います。
プロットサイズとグラフエリアの件ですが書き方が悪かったです。
例えば、10個のグラフが有ったとして全てのグラフエリアが同じで
プロットエリアはグラフエリアよりも小さいサイズで10個同じという意味です。
家のPCにはExcelが入っていない為火曜日に試したいと思います。
（もし修正が有った場合Wendy02様又宜しくお願いします。）

回答No.2

Wendy02

こんばんは。
なかなか、むつかしい質問だと思いました。

質問1
>グラフエリア・プロットエリアを同じサイズに変更する
これは、できるのでしょうか？
グラフエリア・プロットエリアを同じサイズに変更しようとすると、こちらでは、エラーが発生します。
擬似的に作り上げるだけです。もちろん、判例や数値軸、項目軸などは削除しなければならなくなりました。

そして、コードは、このようにしました。

Sub TestGraphArrangement()
'グラフエリアとプロットエリアの差を近づける
Dim grph As ChartObject
　On Error Resume Next
　For Each grph In ActiveSheet.ChartObjects
　　With grph.Chart
　　　.Axes(xlValue).Delete
　　　.Axes(xlCategory).Delete
　　　.Legend.Delete
　　　.ChartArea.Border.LineStyle = 0
　　　.ChartArea.Interior.ColorIndex = xlNone
　　End With
　Next
End Sub

質問2
グラフを３列というのは、３列づつという意味でしょうね。

まだ、あまり良く見直しておりません。なぜか、間が空きすぎる現象があります。その場合は、繰り返してください。本来は、グラフエリアの　.Width, .Height の大きさを統一したほうがよいです。以下は、統一しない場合を想定しています。その場合、その横並びの一番大きな高さのものを対象にして、下の位置が決まります。

Sub TestGraphPosArrange()
'グラフの位置の調整
Dim grph As ChartObject
Dim i As Integer
Dim sngTop As Single
Dim sngLeft As Single
Dim sngHeight As Single
Dim sngWidth As Single
Dim StartPos As Range
　Set StartPos = Range("D2") '最初のグラフの左端上の位置
　sngTop = StartPos.Top
　sngLeft = StartPos.Left
　For Each grph In ActiveSheet.ChartObjects
　i = i + 1
　　With grph
　　.Top = sngTop
　　　 .Top = sngTop
　　　 .Left = sngLeft + sngWidth + 5 '横は、5ポイント
　　　　sngWidth = sngWidth + .Chart.ChartArea.Width
　　　　If .Chart.ChartArea.Height > sngHeight Then
　　　　　 sngHeight = .Chart.ChartArea.Height
　　　　End If
　　 If i Mod 3 = 0 Then
　　　 sngTop = sngTop + sngHeight + 5　'縦の間は、5ポイント
　　　 sngWidth = 0
　　 End If
　　End With
　Next
End Sub

回答No.1

Kazamin

質問1に関して
コレクションとFor Each ～ Nextループで実現可能です。

Sub Macro1()
Dim objCollection As Object
Dim obj1 As Object

Set objCollection = Selection

For Each obj1 In objCollection
With obj1
.Width = 400
.Height = 300
End With
Next obj1
End Sub

「Set objCollection = Selection」で選択されているものをオブジェクト変数にセットします。

この時、objCollection変数はオブジェクトのコレクションとしてふるまいますので、

For Each ～ Next ループでコレクションの要素を一つずつプロパティセットしてあげればいいわけです。

質問2に関しては、このループの中でTopとLeftプロパティをどう設定してやるかです。あえてサンプルコードは書きません。ご自分で試してみてください。

お礼

回答ありがとう御座いました。
火曜日に試したいと思います。