| |
整理したらこんな感じです。
Sub Program1()
Dim a As Long
'
Dim co As ChartObject, ns As Series
Dim cc(1 To 3) As Range, II As Integer, tf As Boolean, ss(1 To 3) As String
'プロンプト内容
ss(1) = "X軸DATAの先頭を選択してください。"
ss(2) = "y軸DATAの先頭を選択してください。"
ss(3) = "y軸項目名を選択してください。"
'埋め込みグラフ追加
With Application.ActiveSheet.Range("A1:E10") 'A1:E10の範囲に作る場合
Set co = Application.ActiveSheet.ChartObjects.Add(.Left, .Top, .Width, .Height)
End With
'グラフタイプ
co.Chart.ChartType = xlLine
For a = 1 To 10
'各種セルを選択
tf = True
For II = 1 To 3
Set cc(II) = Nothing '念のため初期化
'InputBoxでセット(キャンセルするとエラーになるのでエラースキップ)
On Error Resume Next
Set cc(II) = Application.InputBox(Prompt:=ss(II), Default:="A1", Type:=8)
On Error GoTo 0
If cc(II) Is Nothing Then
MsgBox "キャンセルを押しました", vbExclamation
tf = False: Exit For
End If
Next
'無事に３つともセットしていたら、
If tf = True Then
'X,Y系列データは範囲を拡張
For II = 1 To 2
With cc(II).Parent
Set cc(II) = .Range(cc(II), cc(II).End(xlDown)) '拡張
End With
Next
Set ns = co.Chart.SeriesCollection.NewSeries
'グラフを書く
With ns
.XValues = cc(1)
.Values = cc(2)
.Name = "=" & cc(3).Address(ReferenceStyle:=xlR1C1, External:=True)
End With
End If
'グラフ描画
DoEvents
'系列を追加
If MsgBox("波形を追加しますか？", vbYesNo + vbQuestion, "") = vbNo Then Exit For
Next a
'終了
Set ns = Nothing: Set co = Nothing
Erase cc, ss
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 07/2/15(木) 15:27 -
