VBA繪製Excel圖表



VBA調試運行進入:

右鍵Excel的Sheet - 查看代碼 - Microsoft Visual Basic for Applications(VBA)

  爲了方便,建議開啓“開發工具”欄

文件 - 選項 - 自定義功能區 - 勾選“開發工具”



幾個例子:

刪除工作表內所有圖表

Sub 刪除全部圖表()
    ActiveSheet.ChartObjects.Delete
End Sub

VBA測試例子

錄製一個宏

' 錄製的創建折線圖代碼
Sub 宏12()
'
' 宏12 宏
'

'
    Range("D1,D2:D16,E1,E2:E16,G1,G2:G16,H1,H2:H16").Select ' 選擇數據區域
    Range("H2").Activate
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select        ' 選擇插入折線圖
    ActiveChart.SetSourceData Source:=Range( _
        "測試Sheet名稱!$D$1,測試Sheet名稱!$D$2:$D$16,測試Sheet名稱!$E$1,測試Sheet名稱!$E$2:$E$16,測試Sheet名稱!$G$1,測試Sheet名稱!$G$2:$G$16,測試Sheet名稱!$H$1,測試Sheet名稱!$H$2:$H$16" _
        )                                                   ' 圖表的數據選區
    Application.CutCopyMode = False                         ' 取消剪切賦值模式
    Application.CutCopyMode = False
    ActiveChart.FullSeriesCollection(1).XValues = "=測試Sheet名稱!$B$2:$B$16" ' 選擇 X 軸座標選區
    ActiveChart.SetElement (msoElementLegendRight)          ' 選擇圖例右邊顯示
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = "我是標題"                 ' 設置標題名稱
    Selection.Format.TextFrame2.TextRange.Characters.Text = "我是標題"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 4).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 4).Font ' 字體設置
        .BaselineOffset = 0
        .Bold = msoFalse
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(89, 89, 89)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 14
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Spacing = 0
        .Strike = msoNoStrike
    End With
End Sub


簡化宏再使用

由錄製得到的內容可以簡化後使用:

Sub 生成圖表()
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select        ' 選擇插入折線圖
    ActiveChart.SetSourceData Source:=Range("測試Sheet名稱!$D$1:$D$16,$E$1:$E$16,$G$1:$G$16,$H$1:$H$16")   ' 圖表的數據選區
    ActiveChart.FullSeriesCollection(1).XValues = "=測試Sheet名稱!$B$2:$B$16" ' 選擇 X 軸座標選區
    ActiveChart.SetElement (msoElementLegendRight)          ' 選擇圖例右邊顯示
    ActiveChart.ChartTitle.Text = "我是標題"                 ' 設置標題名稱
End Sub

大量圖表可採用for循環

Sub 批量生成圖表()
Dim numInt, cntInt As Integer
Dim sheetNameStr, rowStartStr, rowEndStr, titleNameStr As String
sheetNameStr = "測試Sheet名稱":
cntInt       = 0:
    For numInt = 2 To 500 Step 20
        rowStartStr   = Replace(Str(numInt), " ", ""):           ' 去除數字轉字符中的多餘空格
        rowEndStr     = Replace(Str(numInt + 19), " ", ""):
        cntInt        = cntInt + 1:
        titleNameStr  = Replace(Str(cntInt * 10), " ", ""):

        ' 使用簡化的宏
        ActiveSheet.Shapes.AddChart2(227, xlLine).Select:        ' 選擇插入折線圖
        ActiveChart.SetSourceData Source:=Range(sheetNameStr & _
            "!$D$1,$D$" & rowStartStr & ":$D$" & rowEndStr & _
            ",$E$1,$E$" & rowStartStr & ":$E$" & rowEndStr & _
            ",$G$1,$G$" & rowStartStr & ":$G$" & rowEndStr & _
            ",$H$1,$H$" & rowStartStr & ":$H$" & rowEndStr _
            ):   ' 圖表的數據選區
        ActiveChart.FullSeriesCollection(1).XValues = "=" & sheetNameStr & "!$B$" & rowStartStr & ":$B$" & rowEndStr: ' 選擇 X 軸座標選區
        ActiveChart.SetElement (msoElementLegendRight):          ' 選擇圖例右邊顯示
        ActiveChart.ChartTitle.Text = "我是標題:" & titleNameStr  ' 設置標題名稱
    Next
End Sub

上面的代碼生成效果如下:
批量生成圖表

注:

操作 方式
註釋 單引號 '
多行合併 冒號 :
分多行書寫 末尾用下劃線 _
變量定義 Dim varx,vary As String
連接字符串變量和字符串 與號 &
for循環 Dim num As Integer
for num = 1 To 15 Step 2
...循環內容...
Next



CSDN上用積分下載的一個例子

Public Sub CreateChart()
    Dim ws As Worksheet
    Dim myRange As Range
    Dim myChart As ChartObject
    Dim N As Integer
    Dim xmin As Single, xmax As Single, ymin As Single, ymax As Single
    Dim sj As String, X As String, Y As String, A As String, B As String
    Set ws = ThisWorkbook.Worksheets("Sheet1")    '指定數據源工作表
    ws.ChartObjects.Delete     '刪除工作表上已經存在的圖表
    N = ws.Range("A65536").End(xlUp).Row    '獲取數據個數
    X = "數據序列X"    'X座標軸標題
    Y = "數據序列Y"    'Y座標軸標題
    A = "A" & 2 & ":A" & N    'X座標軸數據源
    B = "B" & 2 & ":B" & N    'Y座標軸數據源
    xmin = Application.WorksheetFunction.Min(ws.Range(A))    'X座標軸最小值
    xmax = Application.WorksheetFunction.Max(ws.Range(A))    'X座標軸最大值
    ymin = Application.WorksheetFunction.Min(ws.Range(B))    'Y座標軸最小值
    ymax = Application.WorksheetFunction.Max(ws.Range(B))    'Y座標軸最大值
    Set myRange = ws.Range("A" & 1 & ":B" & N)     '圖表的數據源
    Set myChart = ws.ChartObjects.Add(100, 30, 400, 250)     '創建一個新圖表
    With myChart.Chart
        .ChartType = xlXYScatterSmooth    '指定圖表類型
        .SetSourceData Source:=myRange, PlotBy:=xlColumns    '指定圖表數據源和繪圖方式
        .HasTitle = True    '有標題
        .ChartTitle.Text = "製作圖表示例"
        With .ChartTitle.Font    '設置標題的字體
            .Size = 16
            .ColorIndex = 3
            .Name = "華文新魏"
        End With
        .Axes(xlCategory, xlPrimary).HasTitle = True    'X座標軸有圖表標題
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = X
        .Axes(xlValue, xlPrimary).HasTitle = True    'Y座標軸有圖表標題
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Y
        With .Axes(xlCategory)
            .MinimumScale = xmin      'X座標軸最小刻度
            .MaximumScale = xmax      'X座標軸最大刻度
        End With
        With .Axes(xlValue)
            .MinimumScale = ymin      'Y座標軸最小刻度
            .MaximumScale = ymax      'Y座標軸最大刻度
        End With
        With .ChartArea.Interior    '設置圖表區的顏色
            .ColorIndex = 15
            .PatternColorIndex = 1
            .Pattern = xlSolid
        End With
        With .PlotArea.Interior    '設置繪圖區的顏色
            .ColorIndex = 35
            .PatternColorIndex = 1
            .Pattern = xlSolid
        End With
        With .SeriesCollection(1)
            With .Border    '設置第一個數據系列的格式
                .ColorIndex = 3
                .Weight = xlThin
                .LineStyle = xlDot
            End With
            .MarkerStyle = xlCircle
            .Smooth = True
            .MarkerSize = 5
        End With
        .Legend.Delete     '刪除圖例
    End With
    Set myRange = Nothing
    Set myChart = Nothing
    Set ws = Nothing
End Sub
發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章