VBA选择多张纸的范围

时间:2016-07-08 12:35:29

标签: vba loops charts subroutine

我正在尝试使用子例程在名为Parameter的工作表中运行10个团队名称。每个团队名称都有自己的工作表。我试图让用户选择范围然后让我的子程序运行并根据所选范围为10个团队创建图表。

Sub test()
Dim rng As Range
Dim r As String
Application.ScreenUpdating = False

Dim TeamName As String

Set rng = Application.InputBox( _
Prompt:="Select a range.", _
Title:="Obtain Range Object", Type:=8)

r = "'" & TeamName & "'!" & rng.CurrentRegion.Address(ReferenceStyle:=xlR1C1)

For i = 1 To 10

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

Call charts(TeamName) ' Call subroutine

Next i

Application.ScreenUpdating = True

End Sub

Sub charts(TeamName As String)
Dim strTitle As Integer
Dim chtObj As ChartObject
Dim i As Integer


For Each chtObj In ActiveSheet.ChartObjects
chtObj.Delete
Next

For i = 1 To 42 Step 4

j = j + 1


Endrow = Range("A1").End(xlUp).Row - 1

Set Range1 = r.Offset(Endrow, i + 1)

Sheets(TeamName).Select

strTitle = j

MyFunction = ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLineMarkers
ActiveChart.HasLegend = False
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = "PC " & j
ActiveChart.SetSourceData Source:=Range1

Dim MyWidth As Single, MyHeight As Single
Dim NumWide As Long
Dim iChtIx As Long, iChtCt As Long

MyWidth = 300
MyHeight = 200
NumWide = 5

     iChtCt = ActiveSheet.ChartObjects.Count
     For iChtIx = 1 To iChtCt
         With ActiveSheet.ChartObjects(iChtIx)
             .Width = MyWidth
             .Height = MyHeight
             .Left = ((iChtIx - 1) Mod NumWide) * MyWidth
             .Top = Int((iChtIx - 1) / NumWide) * MyHeight
         End With
     Next

ActiveChart.SetElement (msoElementPrimaryCategoryAxisNone)
ActiveChart.SetElement (msoElementPrimaryValueGridLinesNone)

Next i

End Sub

0 个答案:

没有答案