Creating Charts using VBA and Sub Routines

时间:2016-06-10 10:04:09

标签: excel vba excel-vba charts

I am creating charts using data from a tabs called Team1-Team8. I am creating the charts for each team ok but I can't get the charts into each team tab called "Team a - Charts". Below is the code i have so far for just Team A.My Parameter sheet, Column B has the names of the tabs for the charts and Column A is the Team names. Any pointers would help.

Sub LooproutineCharts()

Dim TeamName As String
Dim TeamNameCharts As String

For i = 4 To 12

TeamName = Sheets("Parameter").Range("A" & i).Value 'identify the location

TeamNameCharts = Sheets("Parameter").Range("B" & i).Value 'identify the location

Call Charts(TeamName) ' Call subroutine

Call Charts(TeamNameCharts) ' Call subroutine

Next i

End Sub

Sub Charts(TeamName As String)

'Create a Line Chart for Healthy Start Docu'

Dim lastRow As Long
Dim ws As Worksheet
Set ws = Sheets(TeamName)

 With Sheets(TeamName)
    lastRow = .Range("U" & Rows.count).End(xlUp).Row
With ws
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.Parent.Name = "Variable A"
    ActiveChart.SetSourceData Source:=.Range("S3:U" & lastRow)

ActiveSheet.Shapes("Variable A").Top = 20
ActiveSheet.Shapes("Variable A").Left = 20
ActiveSheet.Shapes("Variable A").Height = 300
ActiveSheet.Shapes("Variable A").Width = 700

ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = "Variable A" TeamName"



    End With
    End With

    End Sub

1 个答案:

答案 0 :(得分:1)

我建议更新图表子以使用Worksheet.ChartObjects

使用ChartObject,您可以设置它,而不必按名称引用形状。它看起来像这样:

Sub Charts(TeamName As String)
    'Create a Line Chart for Healthy Start Docu'
    Dim theChart As ChartObject
    Dim lastRow As Long
    Dim ws As Worksheet
    Set ws = Sheets(TeamName)

    With ws
        lastRow = .Range("U" & Rows.Count).End(xlUp).Row

        Set theChart = .ChartObjects.Add(Left:=20, Top:=20, Width:=700, Height:=300)
        With theChart.Chart
            .ChartType = xlLineMarkers
            .SeriesCollection.Add Source:=ws.Range("S3:U" & lastRow)
            '.SeriesCollection(1).XValues = ws.Range("S2:U2") 'I have no idea where your xaxis is placed, or if it exist
            .HasTitle = True
            .ChartTitle.Text = TeamName
        End With
    End With

End Sub

我冒昧地假设图表标题应与TeamName参数匹配。我已经为xAxis做好了准备,但是如果它是相关的,或者它被放置在哪里我没有oidea