以下代码可以用来在Excel里批量生成折线图

Function getcolname(ByVal intcol As Long)
    intcol = intcol - 1
    getcolname = IIf(intcol \ 26, Chr(64 + intcol \ 26), "") & Chr(65 + intcol Mod 26)
End Function
  
Sub 批量生成图表()
'
' 批量生成折线图
' by 余灿琳
  
    sheetName = "Sheet1"
    x = 0
    y = 0
    '表格宽度
    chartWidth = 400
    '表格高度
    chartHeight = 200
    Sheets.Add After:=Sheets(Sheets.Count)
    
    'ActiveSheet.Name = "Bug图表"
    '获取sheet1中总的列数
    intcol = Sheets(sheetName).Range("IV1").End(xlToLeft).Column
    strCol = getcolname(intcol)
    '生成图表
    For i = 2 To 6
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlLineMarkers
        '数据范围 Ei:Hi
        ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("E" & i & ":H" & i)
        'xvalue $E$i:$H$i
        ActiveChart.SeriesCollection(1).XValues = "=Sheet1!$E$1:$H$1"
        '表格标题 Sheet1!$C$i
        ActiveChart.SeriesCollection(1).Name = "=" & sheetName & "!$C$" & i
        '设置x轴的类型为文本坐标轴,而不是时间坐标轴
        ActiveChart.Axes(xlCategory).Select
        ActiveChart.Axes(xlCategory).CategoryType = xlCategoryScale
    Next i
    '调整每个图表的位置
    For Each Chart In ActiveSheet.ChartObjects
        Chart.Activate
        ActiveChart.ChartArea.Select
            Chart.Top = y * (chartHeight + 6)
            Chart.Left = x * (chartWidth + 6)
            Chart.Height = chartHeight
            Chart.Width = chartWidth
        x = x + 1
        If x >= 1 Then
            x = 0
            y = y + 1
        End If
    Next Chart
      
End Sub

版权声明:如无特别声明,本文版权归 一年四季 所有,转载请注明本文链接。

(采用 CC BY-NC-SA 4.0 许可协议进行授权)

本文标题:《 Excel 批量生成折线图 》

本文链接:https://www.yucanlin.cn/operation/Excel%E6%89%B9%E9%87%8F%E7%94%9F%E6%88%90%E6%8A%98%E7%BA%BF%E5%9B%BE.html

Contents