如何在当前工作表中将宏引用到单元格区域?

时间:2012-01-12 10:33:11

标签: excel excel-vba vba

我录制了一个宏来在工作表上创建图表。 数据在工作簿的所有工作表中以相同的方式组织,因此我想概括宏以便可以在每个工作表上使用它(或者如果可以通过工作表批处理)。

代码如下所示:

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"

在fr_1上录制了宏后,我现在在第5行和最后一行有了该引用,而我想对活动表格进行一般性引用。

我该怎么做?

2 个答案:

答案 0 :(得分:2)

你可以:

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

答案 1 :(得分:2)

你可以

  • 将所需的工作表添加到数组中,然后只需访问要放置图表的工作表。此代码仅在Arrshts = Array("Sheet1", "Sheet3", "MySheet With Space")
  • 提供的三个工作表名称上运行
  • 仅通过引用本地范围
  • 跳过潜在的命名问题

[已更新 - 为潜在的无效工作表名称添加了错误处理]

    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