Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

35145 / 76738

←次へ　｜　前へ→


	【46795】Re:インプットボックス

りん

- 07/2/15(木) 15:27 -


	引用なし

	パスワード

整理したらこんな感じです。

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

0 hits

▼

【46769】インプットボックス 210 07/2/14(水) 18:59