VBA ボタンに登録すると挙動が変わってしまう

棒グラフの棒の部分の色を半自動で変えるマクロを作っているのですが
先日ようやくテストがうまくいったのでボタンに登録したところ
VBエディタ上ではきちんと動いていたものがうまく動かなくなってしまいました

マクロgraphItemColorChange（グラフの色を変える）を3回呼び出すマクロで
1回目と2回目で「こんな色に変えますよ」というサンプルを2つ表示し
使う人間が選んだ方の色でグラフ「c」の色を変更するという動作をさせているつもりです
VBエディタ上で[f5]を押して動かした時にはきちんと動作するのですが
ボタンに登録した途端にサンプル二つが表示されなくなってしまいました

不要になったサンプルを削除する部分をコメントアウトすると
呼び出し先や呼び出し元も含めて全ての処理が終わった後にサンプル二つが画面上に表れるので
画面にリアルタイム（？）で表示されるかどうかの違いなのだと思うのですが
これをなんとかする方法が見当つきません

どなたか、なぜ挙動が違ってしまうのかや対処方法等ご存じの方いらっしゃいませんでしょうか
環境はExcel2007
ボタンはクイックアクセスツールバーにExcelのオプション→ユーザー設定→コマンドの選択→マクロ
にこのマクロの呼び出し元になるマクロを登録しています
また、このマクロ自体を同じ方法で直接ボタンに登録してもサンプルのグラフは表示されませんでした

----------マクロ-----------

Sub callGraphItemColorChange()
Dim c As Integer
c = 1 ' 色を変えるグラフの番号、実際にはこの値は呼び出し元のマクロからもらう

Dim a, f As Integer, i As Long
Dim LPosition As Long
Dim myChart
Dim sample1 As Long, sample2 As Long

Set myChart = ActiveSheet.ChartObjects(c)

LPosition = myChart.Left
Application.Goto Reference:=Range(myChart.TopLeftCell.Address), Scroll:=True

With myChart.Duplicate
.Left = LPosition + myChart.Width
.Top = myChart.Top

f = 1
sample1 = ActiveSheet.ChartObjects.Count

' Call graphItemColorChange(sample1, f) 'サンプル1の色で色変え用マクロを呼び出す
.Chart.ChartArea.Border.ColorIndex = 3
.Chart.ChartArea.Border.Weight = xlThick
End With
With myChart.Duplicate
.Left = LPosition
.Top = myChart.Top + myChart.Height

f = 2
sample2 = ActiveSheet.ChartObjects.Count

' Call graphItemColorChange(sample2, f) 'サンプル1の色で色変え用マクロを呼び出す
.Chart.ChartArea.Border.ColorIndex = 5
.Chart.ChartArea.Border.Weight = xlThick
End With

a = MsgBox("マクロ使用後に[戻る]で使用前には戻れません" & vbCrLf _
& "なるべく一度保存してから使用してください" & vbCrLf _
& " （一旦戻って保存するなら[キャンセル]）" & vbCrLf _
& vbCrLf _
& "下の色(青枠)に塗り替えようとしています" & vbCrLf _
& "下のものでいいなら[はい(Y)]" & vbCrLf _
& "右のもの(赤枠)なら[いいえ(N)]" & vbCrLf _
& "中止するなら[キャンセル]", vbYesNoCancel)


Debug.Print sample1
Debug.Print sample2
Debug.Print c


ActiveSheet.ChartObjects(sample2).Delete
ActiveSheet.ChartObjects(sample1).Delete

If a = vbYes Then
f = 2
ElseIf a = vbNo Then
f = 1
Else
Exit Sub
End If

' Call graphItemColorChange(c, f) '選んだ方の色で色変え用マクロを呼び出す
End Sub

No.1 ベストアンサー 回答者： DexMachina 回答日時： 2012/05/18 23:49

私自身が使うのは専らAccess VBAばかりなのですが・・・(汗)

こちらで確認した結果、どうにかそれらしい動作をさせることができました。

【Point】
　・複製したChartObjectをSelectしてやることで、VBEからF5キー経由で
　　実行させたのと同じ動作にさせることができる
　・但し、ChartObjectのDuplicateの戻り値のデータ型は、複製元と同じ
　　データ型ではなくObject型のため、そのままSelectを行うとエラーとなる。
　　これを回避するため、Withの対象には「戻り値そのもの」ではなく「Chart
　　Objectsコレクションから取得したChartObjectオブジェクト」を使用する


上記のポイントに加えて、コードの整理(?)を若干したものが、以下のコード
になります。
なお、末尾に「New」をつけてサブの名前を変えていますので、貼り付けて
使用する場合はご注意下さい。


Sub callGraphItemColorChangeNew()
On Error GoTo エラー処理

　　Dim c As Integer
　　c = 1

　　'◆変数はできるだけ型を指定した方が、入力支援機能が有効になるなど、利点が大です◆
　　Dim Wks As Worksheet, Objs As ChartObjects, myChart As ChartObject
　　Dim Dpl1 As ChartObject, Dpl2 As ChartObject
　　Dim sample1 As Long, sample2 As Long
　　Dim a As VbMsgBoxResult, f As Integer, i As Long
　　Dim LPosition As Long, TPosition As Long, WPosition As Long, HPosition As Long

　　'ActiveSheetから順に変数に格納(後で、確実にメモリを解放するため)
　　Set Wks = ActiveSheet
　　Set Objs = Wks.ChartObjects
　　Set myChart = Objs(c)

　　'原本チャートから取得が必要な値などを予め取得
　　With myChart
　　　　LPosition = .Left
　　　　TPosition = .Top
　　　　WPosition = .Width
　　　　HPosition = .Height
　　　　Call .Duplicate
　　　　sample1 = Objs.Count
　　　　Set Dpl1 = Objs(sample1)　　'複製チャートを、Objs(=ChartObjects)経由で変数に格納
　　　　Call .Duplicate
　　　　sample2 = Objs.Count
　　　　Set Dpl2 = Objs(sample2)　　'複製チャートを、Objs(=ChartObjects)経由で変数に格納
　　　　Application.Goto Reference:=Range(.TopLeftCell.Address), Scroll:=True
　　End With

　　'複製チャートの書式設定
　　'◆Duplicateの戻り値ではなく、ChartObjectを使用◆
　　With Dpl1
　　　　f = 1
　　　　' Call graphItemColorChange(sample1, f)
　　　　.Chart.ChartArea.Border.ColorIndex = 3
　　　　.Chart.ChartArea.Border.Weight = xlThick
　　　　.Left = LPosition + WPosition
　　　　.Top = TPosition
　　　　.Select
　　End With
　　With Dpl2
　　　　f = 2
　　　　' Call graphItemColorChange(sample2, f)
　　　　.Chart.ChartArea.Border.ColorIndex = 5
　　　　.Chart.ChartArea.Border.Weight = xlThick
　　　　.Left = LPosition
　　　　.Top = TPosition + HPosition
　　　　.Select
　　End With

　　a = MsgBox("マクロ使用後に[戻る]で使用前には戻れません" & vbCrLf _
　　　　　　& "なるべく一度保存してから使用してください" & vbCrLf _
　　　　　　& " （一旦戻って保存するなら[キャンセル]）" & vbCrLf _
　　　　　　& vbCrLf _
　　　　　　& "下の色(青枠)に塗り替えようとしています" & vbCrLf _
　　　　　　& "下のものでいいなら[はい(Y)]" & vbCrLf _
　　　　　　& "右のもの(赤枠)なら[いいえ(N)]" & vbCrLf _
　　　　　　& "中止するなら[キャンセル]", vbYesNoCancel)

　　Debug.Print sample1
　　Debug.Print sample2
　　Debug.Print c

　　Dpl2.Delete
　　Dpl1.Delete

　　If a = vbYes Then
　　　　f = 2
　　ElseIf a = vbNo Then
　　　　f = 1
　　Else
　　　　GoTo 終了処理
　　End If

　　' Call graphItemColorChange(c, f)

終了処理:
　　'念のため、明示的にメモリを解放して終了
　　Set Dpl1 = Nothing
　　Set Dpl2 = Nothing
　　Set myChart = Nothing
　　Set Objs = Nothing
　　Set Wks = Nothing
　　Exit Sub

エラー処理:
　　'エラー発生時はMsgBoxを表示
　　'(既定の『デバッグ』ボタンなどの表示が必要になった場合は、
　　'　冒頭の「On Error Goto エラー処理」をコメントアウト)
　　MsgBox Err.Number & "：" & Err.Description
　　Resume 終了処理

End Sub


・・・以上です。

この回答へのお礼

遅くなって申し訳ありません
Application.ScreenUpdating = True
を先頭に足したところ解決したのですが、自己解決したことを書き込む方法が分からずそのままになっていました。

解決はしていたのですが
オブジェクトの宣言時のコツや値の習得を一か所でやる等かなり参考になります

わかりやすいソースありがとうございました

お礼日時：2012/06/11 17:11