VBAにてグラフを別シートに張り付ける際にデバックしてしまう。

VBAにてグラフ作成をしています。
Excel2016ではエラーにならないのですが、Office365にて実施すると、エラーしてしまします。

VBAの内容としては、データファイルを開き、2種類のグラフ（散布図・ヒストグラム）を
作成したいのですが、
下記部分にてエラー（指定したアイテムがみつかりませんでした。）します。

エラー部分
ActiveSheet.ChartObjects("グラフ2").Activata
下記の全体コードの’ヒストグラムの1行目の部分が黄色反映されてしまいます。
原因がわかりません。
説明不足でしたら、補足いたしますので、教示お願いいたします。

全体コード
Sub ファイルを開く()
Dim Target As Variant

Target = Application.GetOpenFilename("Excelブック,*.xl??")
If Target = "False" Then Exit Sub
Workbooks.Open Target

'?t?@?C??????i?[
Dim Ret As String
Dim Fso As Object

Target = ActiveWorkbook.FullName

Set Fso = CreateObject("scripting.filesystemobject")
Ret = Fso.getbasename(Target) 'ベース名（拡張子を除くファイル名）を取得

With Workbooks("???????.xlsm")

.Worksheets("sheet1").Range("E35") = Ret
.Worksheets("sheet1").Range("B69") = Ret

End With

'?????
Dim BeforePos As Long
Dim U As Variant
Dim U2 As Variant

BeforePos = Range("R6").End(xlDown).Row
Cells(BeforePos + 2, 22).Formula = "=MAX(R6:R" & BeforePos & ")"

U = Cells(BeforePos + 2, 22).Value

Workbooks("???????.xlsm").Worksheets("sheet1").Range("W35") = U

'??????

BeforePos = Range("R6").End(xlDown).Row
Cells(BeforePos + 3, 22).Formula = "=SUM(R6:R" & BeforePos & ")"
U2 = Cells(BeforePos + 3, 22).Value

Workbooks("???????.xlsm").Worksheets("sheet1").Range("AG35") = U2

〇×判定

If U < 2 Then
Workbooks("???????.xlsm").Worksheets("sheet1").Range("AN35") = "〇"
Else
Workbooks("???????.xlsm").Worksheets("sheet1").Range("AN35") = "×"

End If

散布図

Dim ThisSheet_Name As String
ThisSheet_Name = ActiveSheet.Name
With Charts.Add
.Location Where:=xlLocationAsObject, Name:=ThisSheet_Name
End With

With ActiveChart.SeriesCollection(1)
.ChartType = xlXYScatter '?U?z?}
.XValues = Range("A6", Range("A6").End(xlDown)) 'X??????????w??
.Values = Range("R6", Range("R6").End(xlDown))
.Name = "????" '?}???w??"
End With

ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "????"

ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "????"



Dim ChartObj As Object '?????????Q?l
Set ChartObj = ActiveSheet.ChartObjects(1)

'グラフタイトル

With ChartObj.Chart
.HasTitle = False
.HasLegend = False

End With

'?F????

Dim tmp As Variant, I As Long
tmp = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Values
For I = 1 To UBound(tmp)
If tmp(I) >= 2 Then
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(I)
.Interior.ColorIndex = 3
.Interior.Pattern = xlSolid
End With
End If
Next I


With ChartObj
.Top = Range("C70").Top
.Left = Range("C70").Left
.Height = 233.574
.Width = 350.929
'.Height = Range("C70:AB83").Height
'.Width = Range("C70:AB83").Width

End With

ChartObj.Copy
Workbooks("???????.xlsm").Activate
Sheets("Sheet1").Select
Range("B71").Select
ActiveSheet.Paste



'?q?X?g?O????
Dim pvtChart As Shape

Workbooks(Ret + ".xlsx").Activate

ActiveSheet.Range("R6", Range("R6").End(xlDown)).Select

Set pvtChart = ActiveSheet.Shapes.AddChart2(366, xlHistogram)

'?O???t?^?C?g??
With pvtChart.Chart
.HasTitle = False
'.ChartTitle.Text = Ret

End With

'ヒストグラム

ActiveSheet.ChartObjects("グラフ２").Activata
ActiveSheet.Axes(xlCategory).Select
ActiveSheet.ChartGroups(1).BinsType = xlBinsTypeBinCount
ActiveSheet.ChartGroups(1).BinsCountValue = 11
ActiveSheet.ChartGroups(1).BinsOverflowEnabled = True
ActiveSheet.ChartGroups(1).BinsOverflowValue = 0

With pvtChart
.Top = Range("K56").Top
.Left = Range("K56").Left
.Height = 233.574
.Width = 215.433

End With

pvtChart.Copy
Workbooks("???????.xlsm").Activate
Sheets("Sheet1").Select
Range("AB71").Select
ActiveSheet.Paste

End Sub

No.1 ベストアンサー 回答者： googoo900 回答日時： 2020/05/06 21:54

原因は単純なタイプミスです。

Activataでなく、Activateですね。

修正前　ActiveSheet.ChartObjects("グラフ2").Activata
修正後　ActiveSheet.ChartObjects("グラフ2").Activate

この回答へのお礼

googoo900さん
ありがとうございます。
本当に単純ミスで、修正したら解決いたしました。
まずは基本に立ち返り見直しをしっかりいたします。

お礼日時：2020/05/06 23:06