| |
▼Excel大好きちゃん さん：
こんばんは。
>そのときに、グラフについては、その元データのセル範囲を
>取得して、外部参照なのかどうかをチェックしようと思ったんです。
違うシートどころか外部参照もあるんですね！！
作ってみましたので、確認して下さい。
仕様は、参照しているセルアドレス（外部参照を含む）を新規ブックを作成し、その最左端シートのＡ列に
記述します。
リンク切れの場合もかまわず、取得します。
'==========================================================
Dim regEx, Match, Matches
'==========================================================
Sub test()
Dim cht As Chart
Dim srs As Series
Dim rng As Range
Dim r_add
Set regEx = CreateObject("VBScript.RegExp")
Set cht = ActiveSheet.ChartObjects(1).Chart
Set rng = Nothing
Set bk = Workbooks.add
jdx = 1
For Each srs In cht.SeriesCollection
r_add = edit_addr(srs.Formula, srs.PlotOrder)
If VarType(r_add) >= vbArray Then
For idx = LBound(r_add) To UBound(r_add)
bk.Worksheets(1).Cells(jdx, 1).Value = r_add(idx)
jdx = jdx + 1
Next
End If
Next
Set regEx = Nothing
End Sub
'=================================================================
Function edit_addr(add, podr As Long)
Dim ans()
Dim o_str
wk = Split(Replace$(Replace$(add, "=SERIES(", ""), "," & podr & ")", ""), ",")
jdx = 1
For idx = LBound(wk) To UBound(wk)
Select Case TypeName(Application.Evaluate(wk(idx)))
Case "Range"
ReDim Preserve ans(1 To jdx)
ans(jdx) = wk(idx)
jdx = jdx + 1
Case "Error"
If get_reg_match(wk(idx), "'.*\[.*\].+'!", o_str) = 0 Then
o_str1 = o_str
o_str2 = Replace$(wk(idx), o_str, "")
If TypeName(Application.Evaluate(o_str2)) = "Range" Then
If o_str1 & o_str2 = wk(idx) Then
ReDim Preserve ans(1 To jdx)
ans(jdx) = wk(idx)
jdx = jdx + 1
End If
End If
End If
End Select
Next
If jdx > 1 Then
edit_addr = ans()
Else
edit_addr = ""
End If
End Function
'=============================================================
Function get_reg_match(chk_str, P_string, o_string) As Long
regEx.Pattern = P_string
get_reg_match = 1
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(chk_str)
If Matches.Count = 1 Then
o_string = Matches(0).Value
get_reg_match = 0
End If
End Function
で、testを実行してみて下さい。
|
|
ichinose
- 04/3/15(月) 18:36 -
