現在のシートのセル範囲にマクロを参照する方法は？

Question

ワークシート上にグラフを作成するマクロを記録しました。 データはワークブックのすべてのシートで同じ方法で構成されています。したがって、すべてのシートで使用できるようにマクロを一般化したいと思います（またはワークシートを一括してバッチ処理できる場合）。

ActiveWindow.SmallScroll Down:=-57 
Range("C5:C65").Select 
ActiveSheet.Shapes.AddChart.Select 
ActiveChart.ChartType = xlLine 
ActiveChart.SetSourceData Source:=Range("fr_1!$C$5:$C$65") 
ActiveChart.Axes(xlCategory).Select 
ActiveChart.SeriesCollection(1).XValues = "=fr_1!$A$5:$A$65" 

私はアクティブなシートへの一般的な参照を持っていると思いながら、私は今、5番目と最後の行にその参照を持っているfr_1にマクロを記録した：

のコードは次のようになります。

どうすればよいですか？

Answer 1

次のことが可能です。

Dim aSheet As Worksheet 
For Each aSheet In ActiveWorkbook.Worksheets 
    With aSheet.Shapes.AddChart.Chart 
     .ChartType = xlLine 
     .SetSourceData Source:=aSheet.Range(aSheet.Name & "!$C$5:$C$65") 
     .SeriesCollection(1).XValues = "=" & aSheet.Name & "!$A$5:$A$65" 
    End With 
Next 

手動で選択したシートを手動名でフィルタリングするにはfor each asheet in activewindow.selectedsheets

に変更反復処理したい場合は、

Dim aSheet As Worksheet 
For Each aSheet In ActiveWorkbook.Worksheets 
    select case aSheet.name 
     case "sheet1", "sheet50", "sheet999" 
      With aSheet.Shapes.AddChart.Chart 
       .ChartType = xlLine 
       .SetSourceData Source:=aSheet.Range(aSheet.Name & "!$C$5:$C$65") 
       .SeriesCollection(1).XValues = "=" & aSheet.Name & "!$A$5:$A$65" 
      End With 
    end select 
Next 

Answer 2

あなたは

• は、Arrayに必要なシートを追加して、ちょうどあなたが上のグラフを配置したいシートにアクセスすることができます。

  Sub Sample() 
      Dim ws As Worksheet 
      Dim Arrshts() 
      Dim ArrSht 
      Dim strOut As String 
      Arrshts = Array("Sheet1", "Sheet3", "MySheet With Space") 
      For Each ArrSht In Arrshts 
      On Error Resume Next 
      Set ws = Nothing 
      Set ws = Sheets(ArrSht) 
      On Error GoTo 0 
      If Not ws Is Nothing Then 
       With Sheets(ArrSht).Shapes.AddChart.Chart 
        .ChartType = xlLine 
        .SetSourceData Range("$C$5:$C$65") 
        .SeriesCollection(1).XValues = Range("$A$5:$A$65") 
       End With 
      Else 
       strOut = strOut & (vbNewLine & ArrSht) 
      End If 
      Next 
      If Len(strOut) > 0 Then MsgBox strOut, , "These array names are incorrect and need adjusting" 
      End Sub 
  

  - このコードは、[追加のエラーが潜在的に無効なシート名のために取り扱いを更新しました]だけローカル範囲に

を参照することにより、潜在的なネーミングの問題をスキップArrshts = Array("Sheet1", "Sheet3", "MySheet With Space")

によって供給される3シート名で実行されます