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

Question

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

end-u · Accepted Answer

標準モジュールに以下『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 · Answer

『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 · Answer

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

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

end-u · Answer

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

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

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

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

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

『Sub ラインの追加』で既にLineShapeが追加されているとして、

楽天RSSのようなDDE機能を使ったものでしょうか。

>下記のプロシージャを追加するまでは何の問題もなく正常に動作していました。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング