| 
    
     |  | ビール腹子 さん、こんばんわ。 
 >.ChartTitle.Text = Sht1.Cells(RowPos - 4, 1).Value
 >のところで【cellメソッドは失敗しました。global】とエラーが出ます。
 >調べたところ、chartをactiveにしているときにセルを参照することに怒られているとのことなのですが・・・。
 >セルを参照せずにここのタイトルを取る方法とはあるのでしょうか?
 
 Private Sub commandbutton1_click()
 グラフ作成
 End Sub
 
 Sub グラフ作成()
 Dim Row_No As Integer
 Dim Col_No As Integer
 Dim RowPos As Integer
 Dim i As Integer
 Dim m As Integer
 Dim chtobj As ChartObject
 '
 Row_No = 339
 Col_No = 2
 Application.ScreenUpdating = False
 '
 Do '      'グラフを作るためのloop--------1.
 
 Do      '編集を探すためのloop--------2.
 If Cells(Row_No, 1).Value <> "編集" Then Row_No = Row_No + 1
 If Cells(Row_No, 1).Value = "YЁd(・`∀・)b S!!" Then
 Application.StatusBar = Cells(RowPos - 4, 1).Value
 Application.ScreenUpdating = True
 '一瞬で表示が変わるので見えないと思うけど
 With Application
 .StatusBar = "処理が終わりました"
 .StatusBar = False
 End With
 Exit Sub
 End If
 Loop Until Cells(Row_No, 1).Value = "編集" '--------2.
 '
 RowPos = Row_No + 1
 Row_No = RowPos + 1
 i = 1
 Do       '行(Row_No)の空白セルを見に行くloop--------3.
 If Cells(Row_No, 2) <> "" Then
 Row_No = Row_No + 1
 i = i + 1
 End If
 Loop Until Cells(Row_No, Col_No) = "" '--------3.
 
 Row_No = Row_No - 1
 i = i - 1
 Col_No = 2
 m = 1
 Do       '列(Col_No)の空白セルを見に行くloop--------4.
 If Cells(RowPos, Col_No) <> "" Then
 Col_No = Col_No + 1
 m = m + 1
 Else
 Exit Do
 End If
 Loop Until Cells(Row_No, Col_No) = "" '--------4.
 If m = 1 Then
 m = m
 Else
 m = m - 1
 End If
 Col_No = Col_No - 1
 '
 With Cells(RowPos, 20)
 .FormulaR1C1 = "=INT(RC[-19])"
 .AutoFill Destination:=Range(.Offset(0, 0), .Offset(i, 0))
 Range(.Offset(0, 0), .Offset(i, 0)).AutoFill _
 Destination:=Range(.Offset(0, 0), .Offset(i, m))
 .ClearContents
 End With
 '
 If i > 1 Then
 Set chtobj = ActiveSheet.ChartObjects.Add(Cells(RowPos, 7).Left, Cells(RowPos, 7).Top, 200, 100)
 With chtobj.Chart
 .SetSourceData Source:=Range(Cells(RowPos, 20), Cells(RowPos + i, 20 + m))
 Select Case i
 Case 2:  .ChartType = xlXYScatterSmooth
 Case Else: .ChartType = xlSurface '3以上
 End Select
 .HasTitle = True
 .ChartTitle.Text = Cells(RowPos - 4, 1).Value
 .HasLegend = False
 End With
 End If
 Loop     '--------1.
 End Sub
 
 実働部分をみなおしました。うまく動くといいですが。
 ボタンからも、直接実行も可能です。
 
 |  |