• ベストアンサー

ExcelVBA 変数を使って項目軸ラベルを追加するには

Excel2000 VBAで 一度作ったグラフに 項目軸ラベルを追加しようとすると エラーが出ます. Dim MyWorkBookName As String Dim MySheetName As String Dim LastRow As Integer MyWorkBookName = ActiveWorkbook.Name MySheetName = ActiveSheet.Name LastRow= 52 With ActiveChart .SeriesCollection(1).XValues = _ Workbooks(MyWorkBookName). _ Worksheets(MySheetName). _ Range(Cells(2, 6), Cells(LastRow, 6)) End With 変数を使って表したいのですが...

質問者が選んだベストアンサー

  • ベストアンサー
  • arata
  • ベストアンサー率49% (139/279)
回答No.3

補足します。 Activeにして使用するのは、あまり良い方法ではありません。Activeにするとスピードが落ちるためです。 基本的に、どのオブジェクトもActiveにしなくても参照できますので、Activeにしないで、良く使うオブジェクトはオブジェクト変数に設定して使用するのがいい方法だと思います。 この場合は、下記のようにすれば、Activeにしないで処理することができます。 Sub test() Dim LastRow As Integer Dim objMySheet As Worksheet Set objMySheet = ActiveSheet LastRow = 52 With objMySheet.ChartObjects(1).Chart .SeriesCollection(1).XValues = _ objMySheet. _ Range(objMySheet.Cells(2, 6), objMySheet.Cells(LastRow, 6)) End With

seebeck
質問者

お礼

>Activeにするとスピードが落ちるためです。 これは良い事を聞きました. ありがとうございます

その他の回答 (2)

  • name_mm
  • ベストアンサー率40% (2/5)
回答No.2

この処理を動作させたときには、正常動作する場合としない場合があります。 グラフをアクティブ(グラフを選択した状態)にし動作させることで、正常動作し、 非アクティブでは、エラーが発生します。 そこで、そのまま使用するためには、任意のグラフをアクティブにする処理 (下記参照)が必要になります。 LastRow = 52 '追加行 -- Start --------------------------------------------------- 'Dim ChaObj As ChartObject ' 'For Each ChaObj In ChartObjects ' Debug.Print ChaObj.Index '出力結果(1)、グラフの数分出力される。 ' Debug.Print ChaObj.Name '出力結果(2)、グラフの数分出力される。 'Next '下記の2行中どちらかを使用 ActiveSheet.ChartObjects(1).Activate '出力結果(1)を()内に使用 ActiveSheet.ChartObjects("Chart 1").Activate '出力結果(2)を()内に使用 '追加行 -- Endt ----------------------------------------------------- With ActiveChart

seebeck
質問者

お礼

アクティブと非アクティブ, 今後気をつけます.

  • arata
  • ベストアンサー率49% (139/279)
回答No.1

Cellsの対象オブジェクトを指定していないためにエラーが出ているのだと思います。 また、シートなどを名前でバインディングしていますが、オブジェクトでバインドしたほうが効率がいいですよ。 Dim LastRow As Integer Dim objMySheet As Worksheet Set objMySheet = ActiveSheet LastRow = 52 With ActiveChart .SeriesCollection(1).XValues = _ objMySheet. _ Range(objMySheet.Cells(2, 6), objMySheet.Cells(LastRow, 6)) End With

関連するQ&A

  • VBA:2つの異なるシートからグラフを作成する

    VBA初心者です。(はじめてから3日目。。。) もしかすると、すごい簡単なことなのかもしれなくて申し訳ないのですが、質問させてください。 二つの異なるシートのデータを使って、円グラフを作製しようとしています。 ですが、「アプリケーション定義またはオブジェクト定義のエラー」が出てしまいます。 どこが間違っているのかをご教授願えませんでしょうか。 よろしくお願いします。 Sub graph() Charts.Add With ActiveChart .ChartType = xlPie .SeriesCollection(1).XValues = Worksheets(1).Range(Cells(2, 3), Cells(2, 5)) .SeriesCollection(1).Values = Worksheets(2).Range(Cells(3, 2), Cells(3, 4)) .SeriesCollection(1).Name = Worksheets(1).Cells(1, 1) .Location where:=xlLocationAsObject, Name:="sheet3" End With End Sub ちなみに、各セルにはちゃんとデータが入っております。 よろしくお願いいたします。

  • グラフの「項目軸ラベルに使用」をVBAで

    VBAで項目軸ラベルの範囲を設定したいのですが分からないので教えてください。データ系列は以下で入れられるのですが・・・ Dim R1 as Range Dim R2 as Range Dim n as Integer Range("a1").Select n=range("h1").value Set R1 =Range(Cells(1,1),Cells(n,1)) Set R1 =Range(Cells(1,2),Cells(n,2)) Sheets("グラフ").Select With ActiveChart .SetSourceData R1 たぶんここに入れるのでは・・・ End With Set R1 = Nothing Set R2 = Nothing

  • 【ExcelVBA】SeriesCollectionのXValuesについて

    はじめまして。 VBAのSeriesCollectionのXValuesについて教えて下さい。 Excel2000のVBAを使用して棒グラフを描こうとしています。 グラフの元データは、セルを使用せずにVBA内での配列を使ってデータを設定しています。 下記プログラムの星印箇所で「SeriesクラスのXValuesプロパティを設定できません」というエラーが発生し、うまく作成できません。 (Y軸に個数、X軸に1週間ごとの日付を表示する単純なプログラムです) 私の環境(WinXP,Excel2000)では、上記プログラムの定数「W_要素数」の値を20から19に減らすとうまく動作するのですが、その仕組みもわかりません。 希望として、下記の条件を満たしたいと考えています。 (1)可能であれば20よりももっと大きい100くらいの要素を指定したい。 (2)セルにデータを書き込み、セルの範囲指定を行う方法はとりたくない。 (XValuesに配列のデータを指定したい) ご存じの方、ご教示願えますでしょうか? ------以下プログラム------ Sub test() Dim i As Long Dim W_シート名 As String Dim W_X軸() As Long Dim W_日付() As Date Dim W_週ごと As String Const W_要素数 As Long = 20 W_シート名 = ThisWorkbook.Worksheets(1).Name Charts.Add.Location Where:=xlLocationAsObject, Name:=W_シート名 ReDim W_X軸(W_要素数) ReDim W_日付(W_要素数) For i = 0 To W_要素数 W_日付(i) = DateAdd("ww", i, CDate(Format$(Now, "yyyy/mm/dd"))) W_X軸(i) = i + 1 Next i ActiveChart.SeriesCollection.NewSeries With ActiveChart.SeriesCollection(1) .ChartType = xlColumnClustered .Values = W_X軸 ★.XValues = W_日付 End With End Sub

  • 初心者です。SeriesCollection(i)はどのように使うのでしょうか

    Sheets("推移グラフ").Select ActiveChart.ChartArea.Select ActiveChart.SeriesCollection(1).XValues = Worksheets(Zsheet2).Range(xrenge1) ActiveChart.SeriesCollection(1).Values = Worksheets(Zsheet2).Range(yrenge1) ActiveChart.SeriesCollection(2).XValues = Worksheets(Zsheet2).Range(xrenge1) ActiveChart.SeriesCollection(2).Values = Worksheets(Zsheet2).Range(yrenge2) ActiveChart.SeriesCollection(3).XValues = Worksheets(Zsheet2).Range(xrenge1) ActiveChart.SeriesCollection(3).Values = Worksheets(Zsheet2).Range(yrenge3) ActiveChart.Deselect に折れ線を1本追加したいのですが、SeriesCollectionの使い方がわかりません。SeriesCollection(i)のiは1~3しか使えないのでしょうか。

  • Excellのvbaにおける、グラフの設定

    このたびは、Excellのvbaにおける、グラフの設定がわからず質問させていただきます。 具体的に、行いたいこととしましては、 円グラフを新規に作成し、データ範囲を指定し、グラフを表示させるということをしたいと考えております。 しかし、項目軸ラベルに使用するデータの設定がうまくいきません。 以下にソースコードをのせますのでアドバイス願います。 Sub AddGrafh()      Range("J4:O4").Select      Dim NowSheetName As String   NowSheetName = ActiveSheet.Name      ActiveSheet.ChartObjects.Add(50, 200, 338, 220).Select   ActiveChart.ChartType = xlPie   ActiveChart.ChartWizard Source:=Range("J4:O4"), PlotBy:=xlRows   ActiveChart.SeriesCollection(1).Name = "=""項目別支出割合"""   ActiveChart.ChartTitle.Font.Size = 14     ActiveChart.SeriesCollection(1).XValues = """=" & NowSheetName & "!$J$3:$O$3"""      End Sub 上記の ActiveChart.SeriesCollection(1).XValues = """=" & NowSheetName & "!$J$3:$O$3""" という箇所の記述がおかしいのですが、なんてかいてよいかわかりません。 ちなみに、項目軸ラベルに設定したいデータは、現在のシートのJ$3:$O$3です。 よろしくお願いします。

  • Excel VBAの散布図について

    Excel VBAで散布図を作ろうと考えています。 元のデータは添付した画像のものです。 左端にXの値があって、それ以降7列ごとに8枚の散布図を作成しようと考えております。 そこで、kを1~8まで動かし8種類の散布図を作成しようと考えているのですが、このマクロではk=1だけプログラムを回しただけで、一枚のグラフにすべての系列が載ってしまいます。 kを動かさずに、Cellの位置を指定して回した際にはうまくいったのですが、kを動かすようにしたところうまくいきません。 散布図を作る際に系列の数(私の場合7種類)を指定するにはどうしたらよいでしょうか。 どなたかご教授ください。 For k = 1 To 8 ActiveSheet.Shapes.AddChart.Select ActiveChart.ChartType = xlXYScatter ActiveChart.SeriesCollection(1).Name = Sheets("Voltammogram").Cells(10, -5 + 7 * k) ActiveChart.SeriesCollection(1).XValues = "=Voltammogram!$A$12:$A$250" ActiveChart.SeriesCollection(1).Values = Sheets("Voltammogram").Range(Cells(12, -5 + 7 * k), Cells(250, -5 + 7 * k)) ActiveChart.SeriesCollection(2).Name = Sheets("Voltammogram").Cells(10, -4 + 7 * k) ActiveChart.SeriesCollection(2).XValues = "=Voltammogram!$A$12:$A$250" ActiveChart.SeriesCollection(2).Values = Sheets("Voltammogram").Range(Cells(12, -4 + 7 * k), Cells(250, -4 + 7 * k)) 以降7列まで続きます。

  • エクセル マクロ ファイルを開きグラフ作成

    VBAを使用して、エクセルファイルをユーダで選択し読み込み 読み込んだエクセルデータからグラフを作成したいと考えています。 コマンドボタンに下記の通り入力しファイルを読み込みました。 Sub ファイルを開いてセルに表示() Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") If OpenFileName <> "False" Then Filename = Dir(OpenFileName) ActiveSheet.Cells(1, 7) = Filename Else MsgBox "キャンセルされました" End If End Sub 読み込んだエクセルファイル、Sheet1をデータとして下記の マクロを実行してグラフを作成したいのですが、どのように手直しを 行ったらよいのか分からないので教えて頂けないでしょうか。 Sub グラフを作成し別シートに貼り付け() '可変範囲折れ線グラフを作成 Dim hani As String shname = ActiveSheet.Name 'シート名を記憶 rmax = Range("A2").End(xlDown).Row '最終行 hani = "C1:C" & rmax & ",E1:E" & rmax Range(hani).Select Charts.Add ActiveChart.ChartType = xlLine ActiveChart.Location Where:=xlLocationAsObject, Name:=shname ActiveChart.SeriesCollection(1).XValues = "='" & shname & "'!R2C1:R" & rmax & "C1" '折れ線グラフを切り取り貼り付け ActiveChart.Parent.Cut Worksheets.Add(after:=Worksheets(Worksheets.Count)) _ .Name = Format(Now(), "グラフ1") ActiveSheet.Paste With Range("A1:F16") ActiveSheet.ChartObjects("グラフ 1").Width = .Width ActiveSheet.ChartObjects("グラフ 1").Height = .Height End With ActiveSheet.ChartObjects(1).Name = "全体グラフ" End Sub

  • 複数シート、計算範囲が可変でのピボットテーブルマクロ

    初めてのマクロで困っています。 エラーメッセージは、 実行時エラー '13': 型が一致しません。 ===で囲んだ部分がデバックをクリックすると黄色で表示されます。 すみませんが、どなたかご指摘お願いします。 どうぞよろしくお願いいたします。 Sub test() Dim i As Integer Dim SET_SheetCnt As Integer Dim SET_SheetName As String Dim SET_SheetN_C As String Dim SET_startRow As Long Dim SET_endRow As Long Dim SET_startCell As String Dim SET_endCell As String Dim SET_Cell As String Dim SET_Returnsheet As String Dim DQ As String Dim SET_FileNo As Integer SET_SheetCnt = ThisWorkbook.Sheets.Count SET_Returnsheet = ActiveSheet.Name SET_FileNo = FreeFile DQ = Chr$(&H22) Sheets(SET_Returnsheet).Cells.Clear For i = 1 To SET_SheetCnt SET_SheetName = Worksheets(i).Name If SET_SheetName <> SET_Returnsheet And SET_SheetName <> "template" Then With ThisWorkbook.Worksheets(i) 'Start行 Cells(2, 2).Select SET_startRow = .Cells.Find(What:="業務名", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False).Row SET_startCell = "R" & SET_startRow & "C3" 'End行 SET_endRow = .Cells(.Rows.Count, 19).End(xlUp).Row SET_endCell = "R" & SET_endRow & "C19" SET_Cell = SET_startCell & ":" & SET_endCell '計算範囲の書き込み Worksheets(SET_Returnsheet).Cells(1, 1).Value = "計算範囲" Worksheets(SET_Returnsheet).Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = "Array(" & DQ & "'" & SET_SheetName & "'!" & SET_Cell & DQ & ", " & DQ & SET_SheetName & DQ & "), " End With End If Next i '最終セルの不要な文字列を取りファイルに格納 Sheets(SET_Returnsheet).Select Dim LastRow As Integer With Worksheets(SET_Returnsheet).Cells.SpecialCells(xlCellTypeConstants).Areas With .Item(.Count) LastRow = .Item(.Count).Row End With End With Dim a As String Dim b As String Dim c As String Dim d As String a = Worksheets(SET_Returnsheet).Cells(LastRow, 1).Value b = Len(a) c = Mid(a, 1, (b - 2)) Worksheets(SET_Returnsheet).Cells(LastRow, 1).Value = c Open "c:\test.txt" For Output As #SET_FileNo For i = 2 To LastRow d = Worksheets(SET_Returnsheet).Cells(i, 1).Value Print #SET_FileNo, d; Next i Close #SET_FileNo Dim FileData As variant Open "c:\test.txt" For Input As #SET_FileNo While Not EOF(SET_FileNo) Line Input #SET_FileNo, FileData Debug.Print FileData Wend Close #SET_FileNo 'ピボット計算------- Worksheets(SET_Returnsheet).Activate Sheets(SET_Returnsheet).Cells.Clear '==ここから黄色で囲まれる分です==== ThisWorkbook.PivotCaches.Add(SourceType:=xlConsolidation, SourceData:= _ Array(FileData)).CreatePivotTable TableDestination _ :=Range("A11"), TableName:="ピボットテーブル1" '===ここまで==== ActiveSheet.PivotTables("ピボットテーブル1").SmallGrid = False ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("データ").PivotItems( _ "データの個数 : 値").Position = 1 Range("A17").Select ActiveWindow.SmallScroll Down:=-9 ActiveSheet.PivotTables("ピボットテーブル1").PivotSelect "行[すべて]", xlLabelOnly Range("A11").Select ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("データの個数 : 値").Function = _ xlSum End Sub

  • excelVBAコードを教えていただけませんか

    excel2000です。 下記コードが簡単そうと思いつつ、いざやろうとすると自分では作ることができず投稿させていただきました。どうかご教授の程よろしくお願いいたします。 excel2000 VBAのコードを教えていただけませんか ・「差し込み表示.xls」から「実験データ」へ値を読みに行き、表示させようとしています。 一日だけの日付をする場合は、下記に記載しているようなコードで対応できるのですが、月を指定して、30(31)日分のデータを読みにいく場合、どういうコードに変更していいか分からず、投稿させていただきました。 ■やりたいこと ・年月を「差し込み表示」のE1セルに記載して、データ読み込みを押すと、したのNO1~31(日付をあらわしています)にそれぞれ対応する値を表示させたい。 ■現物ファイル 現物ファイルを、下記にUPさせて頂きました。差し支えなければ確認いただけると幸いです。よろしくお願いいたします。 ■アップローダー 投稿NO4662 http://www.kent-web.com/pubc/book/test/uploader/uploader.cgi ■一日で読み込むときのプロシ-ジャー Sub datatyuusyutu() Const sashikomiDisplay As String = "差し込み表示.xls" Const dataFile As String = "実験データ.xls" Dim i As Long Dim j As Long Dim k As Long Dim objectionrow As Long Dim lastRow As Long Dim targetDate As String Dim targetTime As String Dim data(1 To 43) As Double Dim dataFindFlag As Boolean Dim 対象フォルダ As String '検索する年月日を取得 targetDate = Range("E5").Value 対象フォルダ = ThisWorkbook.Path & "\" Workbooks.Open 対象フォルダ & dataFile lastRow = Cells(Rows.Count, "B").End(xlUp).Row 'B列の最終行を得る '年月日で検索 For i = 2 To lastRow If Cells(i, 2) = targetDate Then Cells(i, 2).Select dataFindFlag = True For k = 1 To 43 data(k) = Val(Cells(i, k)) Next k Exit For End If Next i Windows(sashikomiDisplay).Activate With Workbooks(dataFile) If dataFindFlag = True Then Cells(1, 2) = data(1) Cells(12, 3) = data(4) Cells(14, 6) = data(5) MsgBox "実行しました" Else MsgBox "データがありません" End If End With Workbooks(dataFile).Close savechanges:=False End Sub

  • VBAのグラフに違うシートの系列の追加について??

    VBAでグラフに新たな系列を追加しようと思い 以下のプログラムを書きました。 しかしながら、 . Valuesの値の指定の場所でエラーが発生しました。 また、 .XValues = Sheets(シート名(o)).Range(Cells(2, 1), Cells(行の数 + 1, 1)) .Values = Sheets(シート名(o)).Range(Cells(2, p + 1), Cells(行の数 + 1, p + 1)) を .XValues = Range(Cells(2, 1), Cells(行の数 + 1, 1)) .Values = Range(Cells(2, p + 1), Cells(行の数 + 1, p + 1)) に直すとうまくいきました。 別のシートの値をグラフに設定する方法がわかっていないみたいなのですが、 やり方がよくわかりません。 もし、わかる方がいたら教えていただけないでしょうか? よろしくお願いします。 以下、書いたプログラムです。 o=2 ActiveSheet.ChartObjects("グラフ1 " ).Activate ActiveChart.SeriesCollection.NewSeries 'グラフの種類・データの範囲・凡例・2軸の使用を指定します With ActiveChart.SeriesCollection(o) 'グラフの種類を設定 折れ線グラフ .ChartType = xlXYScatterLines 'データの指定 .XValues = Sheets(シート名(o)).Range(Cells(2, 1), Cells(行の数 + 1, 1)) '←ここでエラーが出ます。 .Values = Sheets(シート名(o)).Range(Cells(2, p + 1), Cells(行の数 + 1, p + 1)) '凡例の指定 .Name = シート名(o) End With

専門家に質問してみよう