1, 自动生成图表
‘lhome/thread-1058346-1-1.html
‘统计报告0925a.xls
‘2013-9-25
Sub lqxs()
Dim Arr, ks, js, nm1$, nm2$, dz1$, dz2$
Dim dz$, dz3$, yy$, nm$
Application.ScreenUpdating = False
Sheet3.Activate
Arr = [a1].CurrentRegion
ks = 3: js = UBound(Arr) - 1
    nm = Sheet3.Name
    yy = Left(nm, Len(nm) - 3)
    nm1 = "图表 6"
    nm2 = "图表 4"
    dz = "A2:B" & js & ",D2:E" & js
    ActiveSheet.ChartObjects(nm1).Activate
    With ActiveChart
        .SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:=xlColumns
        .SeriesCollection(1).Select
        dz1 = "R3C2:R" & js & "C2"
        .SeriesCollection(1).Values = "='" & nm & "'!" & dz1
        dz2 = "R3C4:R" & js & "C4"
        .SeriesCollection(2).Values = "='" & nm & "'!" & dz2
        dz3 = "R3C5:R" & js & "C5"
        .SeriesCollection(3).Values = "='" & nm & "'!" & dz3
        .ChartTitle.Select
        Selection.Characters.Text = yy & "月份合格率"
    End With
    ActiveSheet.ChartObjects(nm2).Activate
    With ActiveChart
        .ChartArea.Select
        dz = "H2:T2,H" & js + 1 & ":T" & js + 1
        .SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:= _
        xlRows
        dz2 = "R" & js + 1 & "C8:R" & js + 1 & "C20"
        .SeriesCollection(1).Values = "='" & nm & "'!" & dz2
        .ChartTitle.Select
        Selection.Characters.Text = yy & "月份不良趋势统计"
    End With
Range("A" & ks).Select
Application.ScreenUpdating = True
MsgBox "OK"
End Sub
2, 批量插入图表
‘2010-9-27
‘批量绘图表.xls
Sub ChartsAdd()
      Dim myChart As ChartObject
      Dim i As Integer
      Dim R As Integer
      Dim m As Integer
      R = Sheet1.Range("A65536").End(xlUp).Row - 1
      m = Abs(Int(-(R / 4)))
      Sheet2.ChartObjects.Delete
      For i = 1 To R
          Set myChart = Sheet2.ChartObjects.Add _
              (Left:=(((i - 1) Mod m) + 1) * 350 - 320, _
              Top:=((i - 1) \ m + 1) * 220 - 210, _
resize函数vba              Width:=330, Height:=210)
          With myChart.Chart
              .ChartType = xlColumnClustered
              .SetSourceData Source:=Sheet1.Range("B2:M2").Offset(i - 1), _
              PlotBy:=xlRows
              With .SeriesCollection(1)
                  .XValues = Sheet1.Range("B1:M1")
                  .Name = Sheet1.Range("A2").Offset(i - 1)
                  .ApplyDataLabels AutoText:=True, ShowValue:=True
                  .DataLabels.Font.Size = 10
              End With
              .HasLegend = False
              With .ChartTitle
                  .Left = 5
                  .Top = 1
                  .Font.Size = 14
                  .Font.Name = "华文行楷"
              End With
              With .PlotArea.Interior
                  .ColorIndex = 2
                  .PatternColorIndex = 1
                  .Pattern = xlSolid
              End With
              .Axes(xlCategory).TickLabels.Font.Size = 10
              .Axes(xlValue).TickLabels.Font.Size = 10
          End With
      Next
      Sheet2.Select
      Set myChart = Nothing
End Sub
3, 批量插入图表
‘2013-9-30
‘lhome/forum.php?mod=viewthread&tid=1059674&page=1#pid7221588
Sub OpenFiles()
Dim myX As Range
Dim myY As Range
Dim i%, j&
Application.ScreenUpdating = False
ActiveSheet.ChartObjects("图表 1").Activate
For i = 1 To ActiveChart.SeriesCollection.Count  ‘序列集合对象的用法
    ActiveChart.SeriesCollection(i).Delete  ‘删除原有的序列
Next
With ActiveChart.Axes(xlCategory)
    .MaximumScale = 100
    .MinimumScale = 0
    .MajorUnit = 20
    .MinorUnit = 4
End With
With ActiveChart
    .ChartType = xlXYScatterLinesNoMarkers  ‘散点图
    For i = 1 To Sheet1.Range("IV1").End(xlToLeft).Column + 1 Step 2
        j = Sheet1.Range("A65536").Offset(0, i - 1).End(xlUp).Row
        Set myX = Sheet1.Cells(4, i).Resize(j - 3, 1)
        Set myY = myX.Offset(0, 1)
        With .SeriesCollection.NewSeries
            .Values = myY
            .XValues = myX
            .Name = Sheet1.Cells(1, i).Value  ‘序列名
            .MarkerStyle = -4142  ‘没有标志显示
        End With
    Next i
End With
[a1].Select
Application.ScreenUpdating = True
End Sub
4, 图表对象
您可以结合使用 Add 方法和 ChartWizard 方法，添加包含工作表数据的新图表。本示例将基于名为 Sheet1 的工作表上单元格 A1:A20 中的数据添加一个新的折线图。
With Charts.Add
    .ChartWizard source:=Worksheets("Sheet1").Range("A1:A20"), _

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。