Excelマクロ:全シートの埋込グラフのタイトルをシート名にする方法

このQ&Aのポイント
  • Excel2000マクロを使用して、全てのシートに対して埋込グラフのタイトルをシート名に変更する方法を教えてください。
  • マクロの中のChartObjectsメソッドが失敗してエラーメッセージが表示されることがあります。エラーハンドリングが効いているので、エラーが発生した場合はErrHandlerにジャンプします。
  • 1つのシートには0から3個のグラフがあります。それぞれのグラフのタイトルをシート名に設定するために、ChartObjectsを使用しています。
回答を見る
  • ベストアンサー

Excel2000マクロ_全てのシートに対して埋込グラフのタイトルをシート名にする

何方か、回答をお願いします。 下記のマクロは全てのシートに対して埋込グラフのタイトルをシート名にする物ですが ChartObjectsメソッドは失敗しましたと出るときが有ります。 On Error GoTo が効いてErrHandlerに行くときも有るのでよく分かりません。 有識者の方々のもっと良いコードを教えて下さい。 (1つのシートに対してグラフは0~3個です。) Sub シート名グラフ名() Dim mysheet As Worksheet For Each mysheet In Worksheets On Error GoTo ErrHandler With mysheet.ChartObjects(1).Chart .ChartTitle.Text = mysheet.Name End With With mysheet.ChartObjects(2).Chart .ChartTitle.Text = mysheet.Name End With With mysheet.ChartObjects(3).Chart .ChartTitle.Text = mysheet.Name End With ErrHandler: Next mysheet End Sub

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

こんばんは。 ためしに、元のコードに付け足してみました。 不必要なものは、削除してしまってください。 Sub グラフ名前調査() 'グラフをアクティブにしておく Dim strName As String Dim ChartName As String Dim myChart As Object Dim i As Integer Dim t As String strName = StrConv(TypeName(Selection), vbUpperCase) If strName = "CHARTAREA" Or _   strName = "GRIDLINES" Or _   strName = "PLOTAREA" Then   ChartName = ActiveChart.Name '名前   i = ActiveChart.Parent.Index 'インデックス   t = ActiveChart.ChartTitle.Caption 'タイトル     MsgBox "名前:" & ChartName & vbCrLf & _      "インデックス: " & CStr(i) & vbCrLf & _      "タイトル:" & t End If End Sub

hibohibo
質問者

お礼

Wendy02様回答ありがとう御座います。 名前・インデックス値等取れることを確認しました。 今回も、勉強になるコードありがとう御座いました。

その他の回答 (2)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんばんは。Wendy02です。 それは良かったです。VBAで、出来そうで出来ないのが、グラフですね。経験(=失敗の数)に勝る学習はありませんね。 >シート名+コメントみたいに変更出来ませんでしょうか? >(sh.Name & "(グラフ1)" sh.Name & "(グラフ2)" sh.Name & "(グラフ3)"  出来ると思いますが、ただ、"(グラフ1)" というのは、たぶん、作った順で、位置の順ではありませんから、もし、それでは上手くない時は、また考えます。 また、一応、シートごとで、番号を振ることにします。 Sub ChartTitleArrangeR() Dim sh As Variant Dim cht As Variant Dim i As Integer For Each sh In Worksheets  For Each chrt In sh.ChartObjects   With chrt    i = i + 1    .Chart.HasTitle = True    .Chart.ChartTitle.Characters.Text = sh.Name & "(グラフ" & CStr(i) & ")"   End With  Next chrt  i = 0 Next sh End Sub

hibohibo
質問者

補足

Wendy02様何時も回答ありがとう御座います。 私の補足質問が間違っていました、すみません。 シート名+コメントなのですが、sh.Name & "(グラフ東京)"、sh.Name & "(グラフ大阪)" こんな感じで数字でなく文字でした。 後もう一つ別件ですが良ければ教えて下さい。 下記のマクロでグラフの名前は取れますが、ChartObjects(3)と言うような インデックス番号(間違っているかも?)この場合3を調べたのですがどの様な コードを書けば宜しいのでしょうか。? Sub グラフ名前調査() 'グラフをアクティブにしておく Dim namaaa As String namaaa = ActiveChart.Name MsgBox namaaa End Sub

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.1

こんばんは。Wendy02です。 私は、今、前の発言を調べてみたけれども、以前、それについては書かなかったようですね。 今回は、前回の失敗を学んで、Excel2000で調べております。 最初は、まず、エラー・トラップは入れておりません。これで試してみていただけますか? Sub ChartTitleArrange() Dim sh As Variant Dim cht As Variant For Each sh In Worksheets  For Each chrt In sh.ChartObjects   With chrt    .Chart.HasTitle = True    .Chart.ChartTitle.Characters.Text = sh.Name   End With  Next chrt Next sh End Sub

hibohibo
質問者

補足

Wendy02様何時も回答ありがとう御座います、作動確認してバッチリでした。 もし良ければですが、補足質問をお願いします。 現在はシート名とグラフタイトルはシート内で同じですが、 シート名+コメントみたいに変更出来ませんでしょうか? (sh.Name & "(グラフ1)" sh.Name & "(グラフ2)" sh.Name & "(グラフ3)"  こんな感じ)

関連するQ&A

  • グラフの自動描画を行うときに系列名を非表示に

    下記のマクロでグラフを自動描画しています。 この中で、いくつかの点で自分の思うような描画ができていません。今は、描画後に手動にて対応していますが、できることならその手間を省きたく思っています。 ・系列名は不要 ・縦軸、横軸のフォントサイズを指定したい ・データラベルが「0(ゼロ)」の場合は表示しない 何しろマクロ初心者なものです。ご教示をお願いします。 Sub グラフ作成() With ActiveSheet.Shapes.AddChart.Chart .ChartType = xlColumnClustered .SetSourceData Range("V5:W49") End With Dim i As Long With ActiveSheet.ChartObjects(1).Chart For i = 1 To .SeriesCollection.Count .SeriesCollection(i).HasDataLabels = True Next i End With With ActiveSheet.ChartObjects(1).Chart .HasTitle = True .ChartTitle.Characters.Text = Range("W2") & "製造年別グラフ" With .ChartTitle.Format.TextFrame2.TextRange.Font .Size = 6 .Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent2 End With With .Axes(xlCategory, xlPrimary) '---主軸項目軸 .HasTitle = True '---軸ラベル表示 .AxisTitle.Text = "製造年" '---軸ラベル文字列設定 .AxisTitle.Font.Size = 4 End With With .Axes(xlValue, xlPrimary) '---主軸数値軸 .HasTitle = True '---軸ラベル表示 .AxisTitle.Text = "数量" '---軸ラベル文字列設定 .AxisTitle.Font.Size = 4 End With End With End Sub

  • EXCEL:セルに表示されているテキストをシート名にしたい

    仕事で請求書関係のEXCELを作っています。 会社情報というシートの会社名(A3セルからA16セルまで)が変更されると、 会社別にある請求書など(各社3シートあります)の会社名が変わるようにしてあります。 下記のコードを使って、各シートの会社名が変わるとシート名も変わるというようにしようと思いましたが、 表面上はテキストでも関数セルのため、セルに直接入力をすれば変わりますが、このままではシート名が自動で変わらないですよね。 ちなみに変更したいシート名は、 シート名        内容 ○○会社       ⇒日報データ ○○会社請求     ⇒請求書 ○○会社請求(鏡)  ⇒請求合計 となり、これが各社分(現在は20社分)あります。 毎月5社ぐらい会社名が変動しますが、 データを入力する事務員さんはEXCEL初心者なので、 毎回シート名を変更することが難しく、作業を自動で行いたいのです。 私自身も、現在VBAを勉強中のため自分の能力ではこれが精一杯で、 困ってしまいました。 どのようなコードを追加したらいいのか、どなたか教えていただけませんでしょうか? どうかよろしくお願いします! Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If .Value = "" Then Exit Sub If .Address(0, 0) = "A1" Then On Error GoTo ELine ActiveSheet.Name = .Value On Error GoTo 0 End If End With Exit Sub ELine: MsgBox "その名称はシート名になりません", 16 End Sub

  • グラフの削除をExcelVBAで行う

    こんばんは。同じシートの中にグラフを3つ作成し、 コマンドボタンを押すとグラフを削除し、新しいグラフを作成するようにしたいのですが、グラフの3つ目を削除のしようとするとエラーが発生してしまいます。 2つ目までは順調に消えるのですが、3つ目のグラフが削除されないのはなぜなのでしょうか。 色々教えていただき何とか形になってきたのですが、確認すると色々とぼろがでてきてしまい、困っています。 どなたか教えていただけないでしょうか。 宜しくお願い致します。 Sub Glafu() Dim chartobj As ChartObject Worksheets("ABC").Activate ActiveSheet.ChartObjects(1).Delete ActiveSheet.ChartObjects(2).Delete ActiveSheet.ChartObjects(3).Delete Set chartobj = Worksheets("ABC").ChartObjects.Add(600, 0, 300, 200) chartobj.Chart.SetSourceData Worksheets("ABC").Range(Range("b2").End(xlDown), ActiveCell.End(xlToRight)) With Worksheets("ABC").ChartObjects(1).Chart .HasTitle = True .charttaitle.Text = "タイトル1" End With Set chartobj = Worksheets("ABC").ChartObjects.Add(600, 200, 300, 200) chartobj.Chart.SetSourceData Worksheets("ABC").Range(Range("e2").End(xlDown), ActiveCell.End(xlToRight)) With Worksheets("ABC").ChartObjects(1).Chart .HasTitle = True .charttaitle.Text = "タイトル2" End With Set chartobj = Worksheets("ABC").ChartObjects.Add(600, 400, 300, 200) chartobj.Chart.SetSourceData Worksheets("ABC").Range(Range("h2").End(xlDown), ActiveCell.End(xlToRight)) With Worksheets("ABC").ChartObjects(1).Chart .HasTitle = True .charttaitle.Text = "タイトル3" End With End Sub

  • Excel VBA グラフを任意sheetに移動させるには?

    アクティブになっているsheetのグラフを参照し、 それを『まとめ』sheetに移動して張り付ける。 現在 ★マークのところでエラーになっています。 オブジェクトは、このメソッドをサポートしていません…と、これは何のエラーになるのでしょうか? アドバイスお願い致します. Sub test() Dim str As String ★str = ActiveSheet.ChartObjects.Name 'strにグラフ名を代入 ←不具合中… Sheets("まとめ").Activate '---sheet 『まとめ』を アクティブにする ActiveSheet.ChartObjects(str).Activate ActiveChart.Paste End Sub

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

    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

  • エクセルのマクロで教えてください。仕事で、種類の異なる20個のグラフを

    エクセルのマクロで教えてください。仕事で、種類の異なる20個のグラフを一つのシートに作成しますが、2個だけ内容が異なるグラフになってします この20個の散布図グラフで、クリックして選択したグラフだけ、y軸の目盛を自動スケールで最大値、最少値、目盛間隔の分割数は5個に自動にできないでしょうか? このサイトなどいくつか調べて、以下でアクティブシートのすべてのグラフ(20個)をセルに入力された値に一括で変更することはできるのですが、クリックして選択したグラフだけ、上記のようにできません。よろしくお願いします。 Sub 全部() Dim co As ChartObject For Each co In ActiveSheet.ChartObjects With co.Chart With .Axes(xlValue) .MinimumScale = Range("A1").Value '最小値 .MaximumScale = Range("A2").Value '最大値 .MajorUnit = Sheets("Sheet1").Range("A3") '目盛間隔 End With End With Next End Sub

  • エクセルのマクロでアクティブシート内の選択した複数のグラフのみ軸の目盛を変更

    エクセルのマクロで教えてください。20個のグラフを一つのシートに作成しますが、この20個の散布図グラフの中から、クリックして選択したグラフだけ、y軸の目盛を自動スケールで最大値、最少値、目盛間隔の分割数は5個に自動にできないでしょうか? いくつか質問サイトを調べて、以下でアクティブシートのすべてのグラフ(20個)をセルに入力された値に一括で変更することはできるのですが、クリックして選択したグラフだけ、上記のようにできません。よろしくお願いします。 Sub 全部() Dim co As ChartObject For Each co In ActiveSheet.ChartObjects With co.Chart With .Axes(xlValue) .MinimumScale = Range("A1").Value '最小値 .MaximumScale = Range("A2").Value '最大値 .MajorUnit = Sheets("Sheet1").Range("A3") '目盛間隔 End With End With Next End Sub

  • ExcelのVBAの保護をかけた時のグラフについて教えてください。

    グラフにタイトルを設定した後、保護をかけると「ChatクラスのHasTitleプロパティを設定できません」といわれてしまい、.HasTitle=Trueで止まってしまいました。シートの保護をかけても動くようにしたいのですが、どうしたらよいのでしょうか。 (保護しなければ通常に動きます。) 'グラフをオブジェクトで配置 set chartObj=worksheets("Sheet1").ChartObjects.Add(200,0,300,200) chartObj.Chart.SetSourceData Worksheets("Sheet1").range(range("b4").End(xlDown),ActiveCell.end(xlToright)) 'タイトルをつける with worksheets("Sheet1").ChartObjects(1).Chart .HasTitle=True .ChartTitle.Text="タイトル" End with 保護をかけてもグラフの作成ができるのに、タイトル部分で止まってしまうのはなぜでしょうか。 よろしくお願い致します。

  • ブック上にあるグラフの外枠を全て消したい

    シート状に複数のグラフ(散布図)が作られてます. これの輪郭線をすべて消去したいです. Excel操作でいうと「グラフエリアの書式設定」→「パターン」タブ→ 輪郭を「なし」となります. 一グラフに対して自動記録マクロをとると,次のようになります. これを,ブック上(シート上でなく)にある全てのグラフオブジェクト に対して施したいのですが,その方法がわかりません. Sub Macro1() ActiveSheet.ChartObjects("グラフ 1").Activate ActiveChart.ChartArea.Select With Selection.Border .Weight = 1 .LineStyle = 0 End With Selection.Interior.ColorIndex = xlAutomatic Sheets("Sheet1").DrawingObjects("グラフ 1").RoundedCorners = False Sheets("Sheet1").DrawingObjects("グラフ 1").Shadow = False End Sub よろしくお願い致します。

  • マクロでのグラフタイトルの存在確認および取得

    グラフタイトルを設定していればグラフタイトルを、設定していなければ「タイトル無i」という文字をstrGTITLEに返そうとしています。(この処理はfor i = 1 to ActiveSheet.ChartObjects.countのループ内で行っています。) 当方マクロ初心者でして、色々調べたりし以下のようなマクロを作成してみたのですが、「このオブジェクトにはタイトルがありません」のエラーが返されます。 どのようにすれば改善できるのでしょうか。 どうぞよろしくお願いいたします。 If ActiveChart.ChartTitle Is Nothing Then '←この行でエラーが起きます strGTITLE = "タイトル無" & i Else strGTITLE = ActiveChart.ChartTitle.Text End If

専門家に質問してみよう