запуск скрипта через все открытые рабочие листы

Question

Я просмотрел 4 других цикла через все открытые листы в книге Excel, которые все искали в stackoverflow. Я очень новичок в VBA, поэтому у меня возникают трудности с пониманием того, как манипулировать этими ответами в моем коде.

Что я хотел бы сделать, так это создать диаграмму на каждом активном листе. Ниже приведен мой код для создания диаграммы в Листе 1 (найденный из другого сообщения и измененных параметров к тому, что мне нужно). Он создает диаграмму именно так, как мне хотелось бы. Я не знаю, как ссылаться на текущий лист в моем коде вместо листа 1, поэтому я знаю, что это мое первое препятствие. Я нашел, как цикл на https://support.microsoft.com/en-us/kb/142126, но он работает только для Листа 1, так как я не знаю, как правильно изменить этот параметр.

Sub chartcreation() 
    Dim sh As Worksheet 
    Dim chrt As Chart 

    Set sh = ActiveWorkbook.Worksheets("Sheet1") 
    Set chrt = sh.Shapes.AddChart.Chart 

    With chrt 
     'Data? 
     .ChartType = xlXYScatterSmooth 
     .SeriesCollection.NewSeries 
     .SeriesCollection(1).Name = "=Sheet1!B1" 
     .SeriesCollection(1).XValues = "=Sheet1!$A$3:$A$630" 
     .SeriesCollection(1).Values = "=Sheet1!$B$3:$B$630" 

     'Titles 
     .HasTitle = True 
     .ChartTitle.Text = "=Sheet1!B1" 
     .Axes(xlCategory, xlPrimary).HasTitle = True 
     .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Range("A2") 
     .Axes(xlValue, xlPrimary).HasTitle = True 
     .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Range("B2") 

     'Formatting 
     .Axes(xlCategory).HasMinorGridlines = False 
     .Axes(xlValue).HasMajorGridlines = True 
     .Axes(xlCategory).MinimumScale = 15 
     .Axes(xlCategory).MaximumScale = 90 
     .Axes(xlValue).HasMinorGridlines = False 
     .Axes(xlValue).MinimumScale = 0 
     .Axes(xlValue).MaximumScale = 60 
     .HasLegend = True 

    End With 



End Sub 

Answer 1

Ваш код настроен очень хорошо и требует лишь нескольких изменений. Сначала пропустите все листы в ActiveWorkbook, а затем измените значения для ссылки на переменную листа.

Sub chartcreation() 
    Dim sh As Worksheet 
    Dim chrt As Chart 

    For Each sh In ActiveWorkbook.Worksheets 
     Set chrt = sh.Shapes.AddChart.Chart 

     With chrt 
      'Data? 
      .ChartType = xlXYScatterSmooth 
      .SeriesCollection.NewSeries 
      .SeriesCollection(1).Name = sh.Range("B1").Value 
      .SeriesCollection(1).XValues = sh.Range("$A$3:$A$630") 
      .SeriesCollection(1).Values = sh.Range("$B$3:$B$630") 

      'Titles 
      .HasTitle = True 
      .ChartTitle.Text = sh.Range("B1").Value 
      .Axes(xlCategory, xlPrimary).HasTitle = True 
      .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = sh.Range("A2") 
      .Axes(xlValue, xlPrimary).HasTitle = True 
      .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = sh.Range("B2") 

      'Formatting 
      .Axes(xlCategory).HasMinorGridlines = False 
      .Axes(xlValue).HasMajorGridlines = True 
      .Axes(xlCategory).MinimumScale = 15 
      .Axes(xlCategory).MaximumScale = 90 
      .Axes(xlValue).HasMinorGridlines = False 
      .Axes(xlValue).MinimumScale = 0 
      .Axes(xlValue).MaximumScale = 60 
      .HasLegend = True 
     End With 
    Next 
End Sub 

---

Испытано

Answer 2

вы можете Переберите листов с помощью

Sheets("Sheetname").Select 

там вы можете просто поставить имя листа в брикеты. Или вы можете использовать это:

WS_Count = ActiveWorkbook.Worksheets.Count 

это дает вам ряд книг из. и по. Выберите, вы можете выбрать один за другим