Excel VBA質問箱 IV

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

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


18 / 13327 ツリー ←次へ | 前へ→

【80920】グラフ書式の統一 しょしんしゃ 19/6/20(木) 19:32 質問[未読]
【80921】Re:グラフ書式の統一 マナ 19/6/20(木) 21:15 発言[未読]
【80922】Re:グラフ書式の統一 マナ 19/6/20(木) 22:50 発言[未読]
【80923】Re:グラフ書式の統一 しょしんしゃ 19/6/21(金) 8:13 お礼[未読]
【80924】Re:グラフ書式の統一 しょしんしゃ 19/6/21(金) 8:15 お礼[未読]
【80925】Re:グラフ書式の統一 しょしんしゃ 19/6/21(金) 13:49 質問[未読]
【80929】Re:グラフ書式の統一 マナ 19/6/21(金) 19:10 発言[未読]

【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
-----------------------------------------------------

【80921】Re:グラフ書式の統一
発言  マナ  - 19/6/20(木) 21:15 -

引用なし
パスワード
   ▼しょしんしゃ さん:

試してみましたが、再現しません。
コードも、自分自身にまで、処理しているのは無駄な気がしますが、
特に問題なさそうです。

【80922】Re:グラフ書式の統一
発言  マナ  - 19/6/20(木) 22:50 -

引用なし
パスワード
   ▼しょしんしゃ さん:

そのグラフは、エラーバーを使用していますか?
こんなのがりました。
ht tps://www.reddit.com/r/excel/comments/7txu9k/excel_crashes_after_but_not_while_running_macro/

【80923】Re:グラフ書式の統一
お礼  しょしんしゃ  - 19/6/21(金) 8:13 -

引用なし
パスワード
   ▼マナ さん

エラーバー使用しておりました。
添付いただいたURLを参考に修正してみます。

ご助力いただきありがとうございました!

【80924】Re:グラフ書式の統一
お礼  しょしんしゃ  - 19/6/21(金) 8:15 -

引用なし
パスワード
   ▼マナ さん

また、併せてActiveChartにもPasteしている点も修正してみようと思います。

この度は誠にありがとうございました。

【80925】Re:グラフ書式の統一
質問  しょしんしゃ  - 19/6/21(金) 13:49 -

引用なし
パスワード
   昨日投稿した内容の続きです。
マナさんのご回答より、Excel動作停止の原因は、
使用しているグラフに含まれているエラーバーの可能性が非常に高いです。

そこで、処理として以下の流れにすることで
Excel動作停止を避けたいと考えています。

【VBA内容】
1.ActiveChartのエラーバーの設定値取得
2.ActiveChartのエラーバーの削除
3.ActiveChartのコピー
4.For文開始
5.各グラフの残したい縦横軸、エラーバーの設定値を変数に格納
6.各グラフのエラーバー削除
7.各グラフにActiveChartの書式をコピー
8.各グラフに変数に格納した縦横軸、エラーバー設定値を反映
9.For文終了

2.のエラーバーの削除方法は分かったのですが、
1.、5.ので使用するErrorBarsプロパティの引数を取得する方法が分かりません。

ご助言のほどよろしくお願いいたします。


▼しょしんしゃ さん:
>マクロ初心者です。
>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
>-----------------------------------------------------

【80929】Re:グラフ書式の統一
発言  マナ  - 19/6/21(金) 19:10 -

引用なし
パスワード
   ▼しょしんしゃ さん:

書式をコピーするのではなく、
コピーしたい書式を、マクロで設定できないのですか。

18 / 13327 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free