Excel 作成したグラフが削除される現象について

質問

DDEリンクで株価のリアルタイムデータを受信して、Excel2007で株価チャートを作成して表示しています。
本文一番下のプロシージャを作成して実行すると、株価チャートに水平線が２本表示されます。ちなみに、プロシージャの内容は、株価チャートに水平線を引くためのもので、水平線のデータはワークシート名「ピボット」のG2～Z2とG3～Z3にあります。G2～Z2には同じ数値が入っており、G3～Z3にはG2～Z2の数値とは異なる同じ数値が入っています。
しかし、ファイルを保存し（ファイル名「株価チャート」）、ファイルを閉じて、再度ファイルを開くと『「株価チャートxlsm」には読み取れない内容が含まれています。このブックの内容を回復しますか？ブックの発行元が信頼できる場合は、[はい]をクリックしてください。」』と表示されてしまいます。
「はい」をクリックすると、「株価チャートxlsm」の修復ウインドウが表示され、以下が表示されます。

削除されたパーツ: /xl/drawings/drawing1.xml パーツ (図形描画)
削除されたレコード: /xl/externalLinks/externalLink2.xml パーツ内の外部数式参照 (外部数式参照によってキャッシュされた値)
削除されたレコード: /xl/externalLinks/externalLink3.xml パーツ内の外部数式参照 (外部数式参照によってキャッシュされた値)

そして、作成した株価チャートが消去された状態でファイルが立ち上がります。
下記のプロシージャを追加するまでは何の問題もなく正常に動作していました。
補足ですが、DDEリンク接続ができないパソコンでファイル名「株価チャート」を立ち上げると上記のようなことはおこらず下記のプロシージャの内容が反映された株価チャートが表示されます。ただし、数式バーの上部に『セキュリティーの警告　リンクの自動更新が無効にされました』と表示されています。ただ、この警告は下記のプロシージャを追加する前からDDEリンク接続ができないパソコンでは表示されていました。

何が問題なのかさっぱりわかりません。
どなたか教えていただけないでしょうか？
よろしくお願いいたします。

ちなみに、私はExcelやVBAに関しては初心者レベルです。
よろしくお願いいたします。

Sub ピボット1()
With Worksheets("板").ChartObjects(1).Chart
With .SeriesCollection.NewSeries
.AxisGroup = xlSecondary
.Values = Worksheets("ピボット").Range("G2:Z2")
.Border.Color = vbRed
.Border.Weight = xlHairline
End With
With .SeriesCollection.NewSeries
.AxisGroup = xlSecondary
.Values = Worksheets("ピボット").Range("G3:Z3")
.Border.Color = vbRed
.Border.Weight = xlHairline
End With
End Sub

回答No.4

end-u · ベストアンサー

標準モジュールに以下『Sub Line調整』を置きます。

Sub Line調整()
　　Dim T　　 As Single　'y軸のTop位置
　　Dim H　　 As Single　'y軸のHeight
　　Dim L　　 As Single　'x軸のLeft位置
　　Dim W　　 As Single　'x軸のWidth
　　Dim mx　　As Single　'y軸最大値
　　Dim mn　　As Single　'y軸最小値
　　Dim gp　　As Single　'最大値と最小値の差
　　Dim r　　 As Range　 'G2:G8セル
　　Dim Lname As Variant 'LineShape名
　　Dim i　　 As Long

　　On Error GoTo errHndlr
　　Set r = Sheets("ピボット").Range("G2:G8")
　　'LineShapeの名前を配列にする。Indexが0から始まるので最初は""
　　Lname = Array("", "HBOP", "R2", "R1", "P", "S1", "S2", "LBOP")
　　With Sheets("板").ChartObjects(1).Chart
　　　　With .Axes(xlValue)
　　　　　　T = .Top
　　　　　　H = .Height
　　　　　　mx = .MaximumScale
　　　　　　mn = .MinimumScale
　　　　End With
　　　　With .Axes(xlCategory)
　　　　　　L = .Left
　　　　　　W = .Width
　　　　End With
　　　　gp = mx - mn
　　　　'rとLnameをLoop処理
　　　　For i = 1 To 7
　　　　　　With .Shapes(Lname(i))
　　　　　　　　.Top = (mx - r(i).Value) * H / gp + T
　　　　　　　　.Left = L
　　　　　　　　.Width = W
　　　　　　End With
　　　　Next
　　End With
errHndlr:
　　Set r = Nothing
　　If Err.Number <> 0 Then MsgBox Err.Number & "::" & Err.Description
End Sub

後は『Sub 軸の調整』の最後にこの『Sub Line調整』をCallします。

もしくは、主軸の最大値・最小値を自動に設定しておけば
DDEリンクで株価が再計算される度にグラフの主軸も更新されるでしょうから、
『Sub 軸の調整』も不要で、【Sheets("板")のシートモジュール】のCalculateからCallすれば良いように思います。

Private Sub Worksheet_Calculate()
　　Call Line調整
End Sub

お礼

end-u 様

さっそくのご回答ありがとうございます。
できました！！
何度も教えていただきまして、本当にありがとうございます。感謝いたします。
ご指摘いただきましたように主軸の最大値・最小値を自動に設定せずにあえて１５分更新にしているのは、株価チャートが１つのシートに４８枚あるからなのです。
以前、他の件で１つのチャートにつき１枚のシートを作ってcalculateイベントを設定したところ（すなわち、４８枚のシートを作ってそれぞれにcalculateイベントを設定したところ）、頻繁にチャート内容が更新されて画面がチカチカして見ているだけで目が非常に疲れるようになってしまったのです。といいますか、目が疲れて画面を見ていられませんでした。
教えていただいた事を４８枚のチャートに拡張していこうと思います。
この度は本当にありがとうございました。

回答No.3

end-u

『Sub ラインの追加』で既にLineShapeが追加されているとして、
Worksheets("ピボット")のSheetModuleに以下。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim T　　 As Single　'y軸のTop位置
　　Dim H　　 As Single　'y軸のHeight
　　Dim L　　 As Single　'x軸のLeft位置
　　Dim W　　 As Single　'x軸のWidth
　　Dim mx　　As Single　'y軸最大値
　　Dim mn　　As Single　'y軸最小値
　　Dim gp　　As Single　'最大値と最小値の差
　　Dim r　　 As Range　 'G2:G8セル
　　Dim Lname As Variant 'LineShape名
　　Dim i　　 As Long

　　On Error GoTo errH
　　Set r = Me.Range("G2:G8")
　　'Change対象セルがG2:G8範囲に存在する場合のみ実行
　　If Not Intersect(Target, r) Is Nothing Then
　　　　'LineShapeの名前を配列にする。Indexが0から始まるので最初は""
　　　　Lname = Array("", "HBOP", "R2", "R1", "P", "S1", "S2", "LBOP")
　　　　With Sheets("板")
　　　　　　With .ChartObjects(1).Chart
　　　　　　　　With .Axes(xlValue)
　　　　　　　　　　T = .Top
　　　　　　　　　　H = .Height
　　　　　　　　　　mx = .MaximumScale
　　　　　　　　　　mn = .MinimumScale
　　　　　　　　End With
　　　　　　　　With .Axes(xlCategory)
　　　　　　　　　　L = .Left
　　　　　　　　　　W = .Width
　　　　　　　　End With
　　　　　　　　gp = mx - mn
　　　　　　　　'rとLnameをLoop処理
　　　　　　　　For i = 1 To 7
　　　　　　　　　　With .Shapes(Lname(i))
　　　　　　　　　　　　.Top = (mx - r(i).Value) * H / gp + T
　　　　　　　　　　　　.Left = L
　　　　　　　　　　　　.Width = W
　　　　　　　　　　End With
　　　　　　　　Next
　　　　　　End With
　　　　End With
　　End If
errH:
　　Set r = Nothing
　　If Err.Number <> 0 Then MsgBox Err.Number & "::" & Err.Description
End Sub

変化したセルに対応するLineだけ処理する事もできますが、
判り難くなりそうだったのでまとめて処理してます。

先にも書きましたが念のため。
Worksheet_Changeイベントは手入力やマクロによってセルの値が変わった時のイベントです。
G2:G8セルが数式によって設定されていたりするなら、
Worksheet_Calculateイベントを使う事になります。
ただし、その数式が別のセルを参照していたりするなら、
Worksheet_ChangeイベントのChange対象セルをその参照元に設定すれば良いです。

お礼

end-u 様

ご回答ありがとうございます。
できました！
私はchangeイベントとcalculateイベントの違いが良く分かっていませんでした。end-u様のご回答で両者の違いが良くわかりました。ありがとうございます。若干変更してcalculateイベントの方で使用しています。
実際に使用してみて、問題点が発覚いたしました。
実際の使用では、株価チャートの最大値と最小値を15分毎に下記のプロシージャをコールして調整しているのです。シート名（板）のＡ７セルには当日高値がA8セルには当日安値が入ります。これらの値はDDEリンクでリアルタイムで更新されます。しかし、これらの値は７本の水平線の値には影響しません。７本の水平線の値は９時前に設定してからは一日中動きません。
９時から１５分毎の調整で株価チャートの主軸の最大値と最小値が変更されても今回作成した７本の直線の表示位置は移動しません。そこで、第２軸の最大値・最小値を主軸の最大値・最小値に合わせるプロシージャを作ったのですが、エラーがでて駄目でした。
考えてみたら、７本の直線はそもそも第２軸上に表示されているわけではないので、水平線の表示位置が動かないのは当たり前ですよね。
どうすれば、主軸の最大値・最小値に合せて７本の水平線の表示位置を動かすことができるのでしょうか？
教えていただけないでしょうか？
よろしくお願いいたします。

Sub 軸の調整()

With Worksheets("板").ChartObjects(1).Chart.Axes(Type:=xlValue)
.MaximumScale = Worksheets("板").Range("A7").Value + 1
.MinimumScale = Worksheets("板").Range("A8").Value - 1
End With
End Sub

回答No.2

end-u

楽天RSSのようなDDE機能を使ったものでしょうか。
実際の環境がないので仮のDDE機能で試してみましたが、どうにも確認できません。
ダメ元で試してみてもいいかもしれないのは
・Windowsスタートメニューから[ファイル名を指定して実行]
　%TEMP%　でフォルダを開いて当日日付以外の不要ファイルを削除してみる。
・Officeの最新の更新プログラムをチェックしてみる。
..などですが、解消する可能性は低いかもしれません。

http://okwave.jp/qa/q6551620.html
前回レス#1のLineShape方式に切り替えたほうが良いでしょう。
"ピボット"シートのG2,G3セルの数値が変化した時にLineを変更したい場合は
"ピボット"シートのシートモジュールでWorksheet_Changeイベント（手入力などの場合）、
あるいはWorksheet_Calculateイベント（数式設定の場合）を作成し、
そこから呼び出す必要があります。

お礼

end-u 様

再びのご回答ありがとうございます。
LineShape方式に切り替えたところ、うまく行きました。ありがとうございます！
大変申し訳ありませんが、もう一つ教えていただけないでしょうか？
LineShape方式で以下のプロシージャを作成しました。
Sub ラインの追加()
With Worksheets("板").ChartObjects(1).Chart
With .Shapes.AddLine(0, 0, 100, 0)
.Name = "HBOP"
.Line.ForeColor.RGB = RGB(255, 0, 0)
End With
With .Shapes.AddLine(0, 0, 100, 0)
.Name = "R2"
.Line.ForeColor.RGB = RGB(255, 0, 0)
End With
With .Shapes.AddLine(0, 0, 100, 0)
.Name = "R1"
.Line.ForeColor.RGB = RGB(255, 0, 0)
End With
With .Shapes.AddLine(0, 0, 100, 0)
.Name = "P"
.Line.ForeColor.RGB = RGB(0, 255, 0)
End With
With .Shapes.AddLine(0, 0, 100, 0)
.Name = "S1"
.Line.ForeColor.RGB = RGB(0, 0, 255)
End With
With .Shapes.AddLine(0, 0, 100, 0)
.Name = "S2"
.Line.ForeColor.RGB = RGB(0, 0, 255)
End With
With .Shapes.AddLine(0, 0, 100, 0)
.Name = "LBOP"
.Line.ForeColor.RGB = RGB(0, 0, 255)
End With
End With
End Sub

つまり、水平線を７本引きたいのです。
しかし、end-u様から教えたいただいたWorksheet_Changeイベントで使うプロシージャに何をどのように追加すればよいのかわかりません。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As Single 'y軸のTop位置
Dim H As Single 'y軸のHeight
Dim L As Single 'x軸のLeft位置
Dim W As Single 'x軸のWidth
Dim mx As Single 'y軸最大値
Dim mn As Single 'y軸最小値
Dim gp As Single '上限と下限の差
Dim HBOP
Dim B2
Dim B1
Dim P
Dim S1
Dim S2
Dim LBOP
On Error GoTo errH
HBOP = Worksheets("ピボット").Range("G2").Value
B2 = Worksheets("ピボット").Range("G3").Value
B1 = Worksheets("ピボット").Range("G4").Value
P = Worksheets("ピボット").Range("G5").Value
S1 = Worksheets("ピボット").Range("G6").Value
S2 = Worksheets("ピボット").Range("G7").Value
LBOP = Worksheets("ピボット").Range("G8").Value
With Worksheets("板").ChartObjects(1).Chart
With .Axes(xlValue)

私にはここまでしかわかりません。
大変申し訳ありませんが、どのようにすればよいのか教えていただけないでしょうか？
よろしくお願いいたします

回答No.1

end-u

>下記のプロシージャを追加するまでは何の問題もなく正常に動作していました。
という事なので、最近行った仕様変更に原因がある事になります。
そのプロシージャの結果、『株価チャートに系列２本追加し、第２数値軸に設定』した事が原因なら、
水平線の表示をやめて元のチャートに戻し、しばらく様子を見てください。

また、数値軸を合わせる為、イベントプロシージャに追加したコードはありませんか？
あれば、それも除外して確認したほうが良いです。

それと、Worksheets("ピボット")とは、株価データ範囲を元にしたピボットテーブルでしょうか。
これは以前からありますか？

お礼

end-u 様

ご回答ありがとうございます。
水平線の表示をやめると正常に動作します。
数値軸を合わせるために追加したイベントプロシージャはありません。
ピボットの名称はピボットテーブルと無関係です。紛らわしい名前で申し訳ありません。Worksheets("ピボット")は水平線を表示するために新しく追加したワークシートです。
ご回答ありがとうございました。