| |
マクロ初心者です。
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
-----------------------------------------------------
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
