| |
>なんか元データのセル範囲を取得するのってないのんな(T_T)
直接取得する方法って、見たことがないですね。
>こっから抽出してかなあかんの？
かもしれませんね。
って、私自身知らないのです。
つんさんに見本を目安箱に載せてもらおうかなって。
もしかしたら、こんな方法でまとめられるのかな？
Dim GrRg As Variant, Ay As Variant, GGG As Range
GrRg = Array("C2:C10", "D5:D10", "E6:E10", "F1:F10", "G9:G10", "H9:H10")
For Each Ay In Selection 'GrRg
If GGG Is Nothing Then
'Set GGG = Range(Ay)
Set GGG = Ay
Else
'Range(GGG, Range(Ay)).Select
'Set GGG = Range(GGG, Range(Ay))
Range(GGG, Ay).Select
Set GGG = Range(GGG, Ay)
End If
Next
GGG.Select
MsgBox GGG.Address(0, 0)
#################
２年位前にどこかで見たのを応用して、途中で放り投げたやつ。
円グラフと他全部じゃないけど取れたような....。
遅いから、別な方法があったら良いのだけれど。
それとグラフが２つあるとダメだったようナ。
全てのグラフに対応できるようにがんばってください。
Sub グラフ取得テスト()
Dim ChtObj As ChartObject, ShNm As String, SCH As String
Dim St0 As String, St1 As String, Ct As Long
Dim TBSt(1 To 2), Flg As Boolean
ShNm = ActiveSheet.Name '"Sheet1"
On Error Resume Next
Set ChtObj = Sheets(ShNm).ChartObjects(1)
On Error GoTo 0
If ChtObj Is Nothing Then Exit Sub
' <x:DataSource>0</x:DataSource>
' <x:Data>Sheet1!$A$1</x:Data>
SCH = "<x:DataSource>0</x:DataSource>"
'St0 = ActiveWorkbook.HTMLProject.HTMLProjectItems(1).Text
'Sheets("Sheet4").Range("A1").Value = St0
Ct = ActiveWorkbook.HTMLProject.HTMLProjectItems.Count
For i = 1 To Ct
St0 = ActiveWorkbook.HTMLProject.HTMLProjectItems(i).Text
If InStr(1, St0, SCH) > 0 Then
If InStr(1, St0, ShNm) > 0 Then
Flg = True
Exit For
End If
End If
Next
Do
N1 = InStr(1, St0, SCH)
St0 = Mid(St0, N1 + Len(SCH) + 1)
N1 = InStr(1, St0, ShNm)
St0 = Mid(St0, N1)
N1 = InStr(1, St0, "<")
St1 = Mid(St0, Len(ShNm) + 2, N1 - Len(ShNm) - 2)
St0 = Mid(St0, Len(St1) + 1)
'If IsEmpty(TBSt(1)) Then
If Len(TBSt(1)) = 0 Then
Nm = 1
Else
Nm = 2
End If
TBSt(Nm) = St1
Loop Until InStr(1, St0, SCH) = 0
MsgBox Range(TBSt(1), TBSt(2)).Address(0, 0), vbInformation, ChtObj.Name & "の範囲"
Set ChtObj = Nothing
Erase TBSt
End Sub
|
|
