Excel VBA質問箱 IV

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

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


35139 / 76732 ←次へ | 前へ→

【46795】Re:インプットボックス
回答  りん E-MAIL  - 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
   '無事に3つともセットしていたら、
   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 質問
【46770】Re:インプットボックス とおりすがり 07/2/14(水) 19:03 発言
【46790】Re:インプットボックス 210 07/2/15(木) 13:56 質問
【46795】Re:インプットボックス りん 07/2/15(木) 15:27 回答
【46798】Re:インプットボックス 210 07/2/15(木) 16:09 お礼
【46800】Re:インプットボックス りん 07/2/15(木) 16:18 発言
【46805】Re:インプットボックス 210 07/2/15(木) 18:07 質問
【46806】Re:インプットボックス りん 07/2/15(木) 18:52 発言
【46820】Re:インプットボックス りん 07/2/16(金) 11:45 回答
【46854】Re:インプットボックス 210 07/2/19(月) 8:46 お礼
【46856】Re:インプットボックス りん 07/2/19(月) 9:32 発言
【46862】Re:インプットボックス 210 07/2/19(月) 11:02 お礼
【46796】Re:インプットボックス Kein 07/2/15(木) 15:27 発言
【46799】Re:インプットボックス 210 07/2/15(木) 16:11 お礼

35139 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free