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

Question

何方か、宜しくお願いします。

質問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）

Wendy02 · Accepted Answer

こんばんは。Wendy02です。

>プロットエリアサイズは固定出来ないのでしょうか？、私が探した所無いようでしたが？Excelの仕様かな？

ある程度は可能ですが、On Error トラップが必要ですね。つまり、そのまま実行してしまうと、物理的？な数値に合わないと、実行時エラーが発生してしまうのです。だいたい、プロットエリアの大きさは、グラフエリアの90%ぐらいだったかな？　だから、理論的に、一旦、プロットエリアの大きさを取って、グラフエリアを変更してしまえば可能だと思うのです。その後で、並びの位置整理すればよいわけですね。でも、そうすると、今度は、グラフ全体の大きさがマチマチになる可能性があるわけです。

それで、最初の私のコードのように、グラフエリアは、余計なものだとして、私は、消してしまったのです。結構、見栄えが良いなって、自負したのですが……。^^;

Wendy02 · Answer

こんばんは。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 · Answer

こんにちは。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 · Answer

#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 · Answer

こんばんは。
なかなか、むつかしい質問だと思いました。

質問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

Kazamin · Answer

質問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プロパティをどう設定してやるかです。あえてサンプルコードは書きません。ご自分で試してみてください。

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

こんばんは。

こんばんは。

こんにちは。

この回答への補足

#2の追伸です。

こんばんは。

質問1に関して

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング