プロが教えるわが家の防犯対策術!

VBAにてグラフ作成をしています。(Excel2016)
下記の内容で作成していますが、困っております。

①下記コードにてデータファイルを取り込みグラフ(散布図・ヒストグラム)を作成し、元ブックの
Sheet1の(B72)と(Y72)に張り付けたいのですがいい方法があればご教示お願いします。

②下記コードのpvtChart.Chart.SetSourceData Source:=ActiveSheet.Range("R6", Range("R6").
End(xlDown))部分にて、
”実行エラー 445 オブジェクトはこの動作をサポートしておりません。”
となりますが、原因はわからず混迷しています。
ご教示いただけると幸いです。

説明不足でしたら、補足をいたしますので、
よろしくお願いいたします。

☆作成コード☆

Sub ?t?@?C???J??()
Dim Target As String

Target = Application.GetOpenFilename("Excel?u?b?N,*.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) '?x?[?X???i?g???q??????t?@?C?????j??擾

Workbooks("???????.xlsm").Worksheets("sheet1").Range("E35") = Ret

'?????
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 & ")"
U = Cells(BeforePos + 3, 22).Value

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

'?Z?~????

If U < 10 Then
Workbooks("???????.xlsm").Worksheets("sheet1").Range("AN35") = "?Z"
Else
Workbooks("???????.xlsm").Worksheets("sheet1").Range("AN35") = "?~"

End If

'?????I??Y???f?[?^????????????v??????B

'????A?N?e?B?u?????????V?[?g????擾
Dim ThisSheet_Name As String
ThisSheet_Name = ActiveSheet.Name

'???O???t??A?N?e?B?u?????????V?[?g???????
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 = True
.ChartTitle.Text = Ret

End With



'With Charts.Add
'.Location Where:=xlLocationAsObject, Name:=ThisSheet_Name
'End With


Dim pvtChart As Shape

Set pvtChart = ActiveSheet.Shapes.AddChart2(366, xlHistogram)
With pvtChart.Chart
.HasTitle = True
.ChartTitle.Text = Ret

End With

pvtChart.Chart.SetSourceData Source:=ActiveSheet.Range("R6", Range("R6").End(xlDown))

End Sub

質問者からの補足コメント

  • へこむわー

    Qchan1962さん
    ご回答ありがとうございます。
    参考サイトをもとに下記のように修正してみましたが、コンパイルエラー(参照が不正または不完全です。)が発生しうまくいきませんでした。
    どこに不正または不完全があるのでしょうか?

    Dim pvtChart As Shape
    .Range("R6", Range("R6").End(xlDown)).Select

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

    With pvtChart.Chart
    .HasTitle = True
    .ChartTitle.Text = Ret
    End With

      補足日時:2020/04/19 21:15
  • うーん・・・

    ご回答ありがとうございます。
    デバックの位置の説明がなく大変申し訳ございませんでした。
    ご教示いただいた方法で②は解消することができました。
    ①はマクロ記録をもとに各グラフ作成コードの最後に
    Selection.Copy
    Windows("???????.xlsm").Activate
    Range("N〇〇").Select
    ActiveSheet.Pictures.Paste.Select
    を記入しましたが、ヒストグラムだけグラフが真っ白になってしまいます。
    何か不正や不完全があるのでしょうか。

      補足日時:2020/04/19 22:24

A 回答 (3件)

グラフをどこかにコピペすると言う事でしょうか?


Selection.Copyは、質問に示しているコードの様に
Set ChartObj = ActiveSheet.ChartObjects(1) がされていれば、

ChartObj.Copy
Windows("???????.xlsm").Activate
Sheets("〇〇").Select
Range("B72").Select
ActiveSheet.Paste

こんな感じで
手元に2016がなく2013なのでヒストグラムは検証できず
    • good
    • 0
この回答へのお礼

Qchan1962さん
これを参考にコード作成を進めていきたいと思います。
ご教示いただきありがとうございます。

お礼日時:2020/04/21 04:56

補足については


検証している訳ではないので、確かではありませんが、
.Range("R6", Range("R6").End(xlDown)).Select
シート参照がないので
ActiveSheet.Range("R6", Range("R6").End(xlDown)).Select
と思いますが、デバッグ位置を示された方が分かり易いと思います。
    • good
    • 0

多分、xlHistogram



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

参考サイト https://stackoverflow.com/questions/37912746/vba …
抜粋:
2016年に導入された新しいExcelグラフには別の手法が必要です。マイクロソフトはこれがバグであることを確認します。
回避策は、範囲を選択してからグラフを追加することです。
    • good
    • 1

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!