VBA調試運行進入:
右鍵Excel的Sheet - 查看代碼 - Microsoft Visual Basic for Applications(VBA)
為了方便,建議開啟“開發工具”欄:
文件 - 選項 - 自定義功能區 - 勾選“開發工具”
幾個例子:
刪除工作表內所有圖表
Sub 刪除全部圖表()
ActiveSheet.ChartObjects.Delete
End Sub
錄制一個宏
' 錄制的創建折線圖代碼
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