Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1537 / 76807

←次へ　｜　前へ→


	【80920】グラフ書式の統一

しょしんしゃ - 19/6/20(木) 19:32 -


	引用なし

	パスワード

マクロ初心者です。
ActiveChartの書式をActiveSheet内の全グラフに反映させる
マクロを作成いたしましたが、
マクロ処理完了後、Excelの動作が停止してしまいます。

VBAのフローに不備がございましたら、教えていただければ幸いです。

【使用PCスペック】
OS：windows10
CPU：Core(TM)i3-6100U CPU @2.30GHz
RAM：4GB

【VBA内容】
縦軸と横軸の最大最小値、目盛りの間隔は元の状態を維持したい為、

1.ActiveChartのコピー
2.For文開始
3.各グラフの残したい縦横軸の設定値を変数に格納
4.各グラフにActiveChartの書式をコピー
5.各グラフに変数に格納した縦横軸設定値を反映
6.For文終了

といった処理を行っています。　

【処理結果】
・ActiveSheet内のグラフの書式は狙ったとおりに反映される
・各グラフの結果を確認する為に、Excelをいじっていると
　10秒程度たった後に動作が停止する

【VBA】
----------------------------------------
Sub グラフ書式の統一()

Dim objChart As Object
Dim x_MinScale As Single
Dim x_MaxScale As Single
Dim y_MinScale As Single
Dim y_MaxScale As Single
Dim x_MjrUnit As Single
Dim y_MjrUnit As Single

On Error GoTo ErrorHandler

If ActiveChart Is Nothing Then
　　MsgBox "基準となるグラフを選択した状態で実行してください"
　　Exit Sub
End If

'基準となるグラフのコピー（後に書式を貼り付け）
ActiveChart.ChartArea.Copy

'全てのチャートにおいて、"縦横軸の設定保持⇒基準グラフの書式貼り付け⇒元の縦横軸の設定に戻す"を繰り返す
For Each objChart In ActiveSheet.ChartObjects
　　
　　
　　'貼り付け先のグラフの横軸の設定を取得
　　With objChart.Chart.Axes(xlCategory)
　　　　x_MinScale = .MinimumScale
　　　　x_MaxScale = .MaximumScale
　　　　x_MjrUnit = .MajorUnit
　　　　
　　End With
　　
　　'貼り付け先のグラフの縦軸の設定を取得
　　With objChart.Chart.Axes(xlValue)
　　　　y_MinScale = .MinimumScale
　　　　y_MaxScale = .MaximumScale
　　　　y_MjrUnit = .MajorUnit
　　End With
　　
　　
　　'基準となるグラフの書式を貼り付け
　　objChart.Select
　　ActiveSheet.PasteSpecial Format:=2
　　
　　'保持していた元の横軸設定を反映
　　With objChart.Chart.Axes(xlCategory)
　　　　.MinimumScale = x_MinScale
　　　　.MaximumScale = x_MaxScale
　　　　.MajorUnit = x_MjrUnit
　　　　
　　End With
　　
　　'保持していた元の縦軸設定を反映
　　With objChart.Chart.Axes(xlValue)
　　　　.MinimumScale = y_MinScale
　　　　.MaximumScale = y_MaxScale
　　　　.MajorUnit = y_MjrUnit
　　End With

Next

''''''

ErrorHandler:
Exit Sub

'''''''

End Sub
-----------------------------------------------------

1 hits

▼

【80920】グラフ書式の統一 しょしんしゃ 19/6/20(木) 19:32