はい、多分みんな知ってるVBA小ネタです。
別のファイル(ワークブック)から表とグラフをコピペして持ってきたあと、いろいろあってそれぞれ保存場所が変わってしまい、リンク元が行方不明だぞ、と怒られるときがあると思います。
セルに設定されているリンクであれば、その文字列の一部を通常検索するとヒットするのですが、グラフなどのオブジェクトにリンクがあると、通常検索ではヒットしないのです。
そんな時に、VBAで探してみよう、というのが今回のネタ。いやね、実際仕事であった話で、シートに種類の違うグラフが10個以上貼り付けられてて、20シートぐらいあるファイルが20ぐらいあって、ファイルを開く度にメッセージが出るのですよ。
こんな感じの。
実際のデータではこう設定されている。
まあ、グラフと数値はシート上にあるので、リンク元が見つけられなくてもグラフをいじらなければまったく問題ないのですし、なんならすぐ上に表があるので設定し直せばいいのですが、やっぱりもやっとするじゃないですか。
で、できたのがこれ。
Dim link As String, findtext As String, gname As String
Dim vgname As Variant
Dim shp As Shape
Dim gcnt As Long, i As Long
findtext = "*" & Range("J2") & "*"
For Each shp In ActiveSheet.Shapes
shp.Select
gcnt = ActiveChart.SeriesCollection.Count
For i = 1 To gcnt
If ActiveChart.SeriesCollection(i).Formula Like findtext Then
Cells(i + 1, 11) = shp.Name
Cells(i + 1, 12) = "" & i & " : " & Mid(ActiveChart.SeriesCollection(i).Formula, 2, Len(ActiveChart.SeriesCollection(i).Formula))
End If
Next i
Next shp
セルに入力したキーワードをもとに、グラフに設定されている参照元の式(Formula)を検索して、ヒットしたら隣のセルに名前とその式(項目数分)を表示するという簡単なものです(SeriesCollection(i).Formulaにたどり着くまでうんうん唸っていたのは内緒)。
ちなみに、仕事で使ったときは複数シートを一括処理するために、シートごとに検索結果をvgnameに格納して、NewCollectionオブジェクトに重複なしで再格納してから書き出していたのでvgnameを入れてますが、今回の処理には必要ないですね。消すのを忘れてました。
素人丸出しの書き方ですが、おかしなところがあればご一報いただけると嬉しいです<(_ _)>
※コメント投稿者のブログIDはブログ作成者のみに通知されます