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

VBA數組

Sub tests()
Dim  my_array()
    my_array  = [{"111", "222", "333", "world"}]

    my_array(1) = "111"
    my_array(2) = "222"
    my_array(3) = "333"
    my_array(4) = "world"
End Sub


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM