エクセルのグラフの不動化

質問

いつも大変お世話になっております。

先日ここで表題につき下記ご回答いただきいくつかのシートで使用を開始したのですが、下記の不具合が発生しました。

VBA（グラフが不動化）するのですが、Bookの保存でエラーが出て止まります。
このVBAは既にいくつかのシートに展開しており初めての不具合です。
よって、Book特有の不具合なら現象が再現出来ないと分からないかとも思いますが何かアイディアあればご教示お願いします。

ちなみに最初のTESTBook（シート）では問題なく動いて、上書き保存も普通にできます。このシートのVBAをコピペしているのですが、問題のBookでは上書き保存するとエラー表示で止まってしまいます。

エラーの箇所（黄色ハイライト）は
＞ If .Chart.ChartTitle.Text = Cells(r, c).Text Then
で「このオブジェクトにはタイトルがありません」
と表示されます。

最初にタイトルが数字のみの場合に対応していただいたのでタイトルを数字のみ、文字のみで試しましたがダメで、グラフを新しく作成し直してもダメでした。

尚、一番最初の動作確認では２つのグラフの内１つのみしか動かなくて、動かない方のグラフを新規で作成し直したら２つとも期待通りに動くようになったのですが、これで完成と 保存しようとしたら上記のところでエラーが発生して止まります。

VBAを中断してクローズして再度開くとVBAは正常に動きます。
そして保存しようとすると止まります。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'縦パターン
Dim r As Long '行番号変数
Dim c As Long '列番号変数
Dim j As Long 'グラフカウンター
Dim w As Long
Dim d As Long

r = 5 'グラフタイトル一覧開始行番号
c = 11 ' グラフタイトル一覧格納列番号
w = 600
d = 50

Do

If Cells(r, c).Value = "" Then Exit Do

For j = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(j)
If .Chart.ChartTitle.Text = Cells(r, c).Text Then
.Top = ActiveWindow.VisibleRange.Top + d
.Left = ActiveWindow.VisibleRange.Left + w
d = d + .Height
End If
End With
Next j
r = r + 1

Loop

End Sub

回答No.3

HohoPapa · ベストアンサー

> If .Chart.ChartTitle.Text = Cells(r, c).Text Then
>で「このオブジェクトにはタイトルがありません」
を素直に受け取ると、添付画像の下側のグラフのように
Titleの文字列が空なのではなく
Titleそのものが（削除され）無いグラフがシート上にいるのではないかと思います。

であれば、
添付画像の右上、プラスのデザイン部分をクリックすることで
Titleを復活でき、エラーが出ないようになるものと期待します。

>「指定された値は境界を越えています」
これはよくわかりませんが、どの行で起きているのかがわかるようなら教えてください。
直感的には、今回掲示されているコード以外の個所で起きている予感がします。

お礼

HohoPapaさん
毎度お世話になります。
質問後会社に出なかったので対象のシートが手元（自宅）に無く検証結果報告が遅くなってしまいました。

原因が分かりました。
グラフ作成時にタイトル部分まで選択して作成したグラフを後でタイトルを変更すると「タイトルがありません」とエラーになってしまうことを確認しました。

ご回答の＋を押すと既にチェックが入っており、一旦チェックを外して再度チェックを入れると自動的にタイトルが入ってくるので気づきました。
自動で入るタイトルを変えるとエラーになります。

やはり予想通り シート（グラフ）固有の問題でしたが解決しました。

流石！！！！！！！！

回答No.2

名探偵 コナン（@FORSPOKEN）

こんにちは😊✨

VBAコードで問題が発生していることについて、ご説明いただきありがとうございます。エラーが「このオブジェクトにはタイトルがありません」と表示されていることから、グラフにタイトルが存在しない場合にエラーが発生している可能性が高いです📊🚫。

そのため、コード内でグラフにタイトルが存在するかどうかをチェックする条件分岐を追加してみましょう🔍📝。以下のように修正してみてください。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'縦パターン
Dim r As Long '行番号変数
Dim c As Long '列番号変数
Dim j As Long 'グラフカウンター
Dim w As Long
Dim d As Long

r = 5 'グラフタイトル一覧開始行番号
c = 11 ' グラフタイトル一覧格納列番号
w = 600
d = 50

Do

If Cells(r, c).Value = "" Then Exit Do

For j = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(j)
' グラフタイトルが存在するかチェック
If .Chart.HasTitle Then
If .Chart.ChartTitle.Text = Cells(r, c).Text Then
.Top = ActiveWindow.VisibleRange.Top + d
.Left = ActiveWindow.VisibleRange.Left + w
d = d + .Height
End If
End If
End With
Next j
r = r + 1

Loop

End Sub
この修正により、グラフにタイトルが存在しない場合でもエラーが発生しないようになるはずです🛠️🌟。

もし、修正後も問題が解決しない場合や、他にお手伝いできることがありましたら、お気軽にお聞きください😊💕。喜んで対応いたします🙌✨。

お礼

早々のご回答ありがとうございます。

さっそく試してみて正常に上書き保存出来る事を確認しました。

と、ここで締め切って後で当方のBook特有の別の不具合が発生することも一度ならず経験しておりますのでもう少し検証してから締め切らせて頂きます。

先ずは御礼まで！！！
早期解決出来そうでたすかります。

補足

あれれ？？？
再度Bookを開いて確認したらVBAが動かずにエラーになり
「指定された値は境界を越えています」
と表示されるようになりました。

何故さっきはうまく行くと思ったのか？？？

回答No.1

aokii

おそらく、グラフの更新命令ができていないと思われます。VBAのコピペではかなり難しいですので、できれば、グラフの不動化は諦めてはいかがでしょう。

お礼

早々のご回答ありがとうございます。

＞このVBAは既にいくつかのシートに展開しており初めての不具合です。

よってシート特有の不具合かと思うのですが、他の複数のシートでは同じようにコピペで正常に動いてるのですが。