简单套用VBA模板代码，对初学VBA并立志在VBA扎根者来说，或许不是最好的办法，但对只需要解决自己一些简单问题的人来讲就是一种捷径。
*********自定义函数*********
Function Nows() '声明函数，无参。时间函数
Dim Tim As String '声明一个变量
Tim = Format(Now, "yyyy-mm-dd hh:mm:ss") '获取当前时间，并转换成文本
Nows = Tim '将文本日期赋与函数
End Function
---------------------------------------------------------------------------------------'
Function nows() '声明函数
Dim tim As String '声明一个变量
tim = Format(Now, "yyyy-mm-dd hh:mm:ss") '获取当前时间，并转换成文本
nows = tim '将文本日期赋予函数
End Function
----------------------------------------------------------------------------------------
Function 工作簿名() '获取当前工作簿名称，无参数
工作簿名 = ActiveWorkbook.Name 'ActiveWorkbook即表示当前工作簿
End Function
---------------------------------------------------------------------------------------
Function 大写(cell As String) As String '声明函数名，有一个参数
Dim RMBS As String
Application.Volatile '声明为易失性函数
If cell = "" Or Not VBA.IsNumeric(cell) Then 大写 = "": Exit Function '如果参数为空或者非数值则返回空白
If cell = 0 Then 大写 = "零元整": Exit Function '如果参数为0则返回“零元整”
'将数值转换成中文大写，并将点替换成“元”，将负号替换成“负”
RMBS = Replace(Replace(Application.Text(Round(cell, 2), "[DBnum2]"), ".", "元"), "-", "负")
'加入角与分,同时将最后的“零”替换成“元整”
RMBS = IIf(Left(Right(RMBS, 3), 1) = "元", Left(RMBS, Len(RMBS) - 1) & "角" & Right(RMBS, 1) & "分", IIf(Left(Right(RMBS, 2), 1) = "元", RMBS & "角", IIf(RMBS = "零", "", RMBS & "元整")))
'将“零元”和“零角”替换成空
RMBS = Replace(Replace(RMBS, "零元", ""), "零角", "")
大写 = RMBS '将变量的值赋与函数
End Function
--------------------------------------------------------------------------------------
Function 工作表(Optional 序号) As String '声明函数，有一个参数可选参数.[列号COLUMN()或行号ROW()]
Application.Volatile '声明为易失性函数
''如果未输入参数，则赋与变量序号为当前表的地址
If VBA.IsMissing(序号) Then 序号 = ActiveSheet.Index
If 序号 > Sheets.Count Then '如果参数大于工作表数量
工作表 = "" '返回空
Else '否则
工作表 = Sheets(序号).Name '取表名
End If
End Function
---------------------------------------------------------------------------------------
Function 关机(Optional Close_Time As Byte = 10) '声明函数名称
关机 = Close_Time '在单元格显示时间
Shell "shutdown -s -t " & Close_Time '在指定的时间内关闭工作表，调用的DOS命令
End Function
Function hesum(rng As Range, Optional 单双 As Byte = 1) '声明函数，有两个参数，第二个是可选参数
Application.Volatile '声明为易失性函数
Dim cell As Range, Sum1, Sum2
For Each cell In rng
If InStr(cell, "/") > 0 Then '如果有“/”
左 = CLng(Left(cell, InStr(cell, "/") - 1)) '提取/左边的数据
右 = CLng(Replace(cell, 左 & "/", "")) '提取/右边的数据
Sum1 = Sum1 + (左 + 右) '将左右相加
Else
Sum2 = Sum2 + cell * 2 '没有“/”则直接乘以2
End If
Next
hesum = (Sum2 + Sum1) / 单双 '汇总后除以第二参数
End Function
Function 排名(区域, 成绩) '声明函数，有两个参数
Application.Volatile '声明为易失性函数
Dim Dic As Object, rng, i As Integer '声明变量，包括一个字典对象
Set Dic = CreateObject("scripting.dictionary") '声明字典对象变量
For Each rng In 区域 '遍历区域
'如果变量rng等于成绩则为变量i赋值1，如果变量rng大于成绩则将rng的值追加到字典中
If rng = 成绩 Then i = 1 Else If rng > 成绩 Then Dic(rng * 1) = 1
Next
'如果变量i大于0,即区域中有数据等于成绩，那么排名结果等于字典中的数量加1（字典对象是忽略重复值的）
If i > 0 Then 排名 = Dic.Count + 1 Else 排名 = "超出范围" '如果成绩与区域中任何不等则返回“超出范围”
End Function
Function Col(Optional rng As Range, Optional style As String = "A") '声明函数名称，有两个可选参数
Application.Volatile '声明为易失性函数
'如果第二参数录入A和a以外的任意字符则返回空白
If style <> "A" And style <> "a" Then Col = "": Exit Function
If rng Is Nothing Then Set rng = ActiveCell '如果忽略第一参数则默认取当前活动单元格
'函数结果等于Cells(1, rng)的地址去除后1之后所对应的字母。然后根据第二参数进行大小写控制
Col = StrConv(Replace(Cells(1, rng.Column).Address(0, 0), 1, ""), IIf(style = "A", vbUpperCase, vbLowerCase))
End Function
----------------------------------------------------------------------------------------
Function 星期(Optional dates As Date, Optional style As Byte = 2) '声明函数名称，具有两个可选参数
Application.Volatile '声明为易失性函数
If dates = 0 Then dates = Date '如果忽略第一参数，则以当日计算
'如果仅仅一个参数，则第参数在1到4之间，则将参数值赋与第二参数，而将当前日期赋与第一参数
If dates < 5 And dates > 1 Then style = dates: dates = Date
Select Case style '根据第二参数值选择星期的格式
Case 1 '第二参数为1
星期 = WorksheetFunction.Text(dates, "aaa") '短写中文
Case 2
星期 = WorksheetFunction.Text(dates, "aaaa") '长写中文
Case 3
星期 = WorksheetFunction.Text(dates, "ddd") '短写英文
Case 4
星期 = WorksheetFunction.Text(dates, "dddd") '长写英文
End Select
End Function
--------------------------------------------------------------------------------------------
Function Connect(ParamArray rng() As Variant) '声明函数名称，有多个可选参数，包括1到255个
Dim cell As Range, celll As Range, i As Integer, cellv As Variant '声明变量
Application.Volatile '声明为易失性函数
Connect = "" '将函数初始化
'遍历参数所代码的对象集合（可能是字符串，可能是区域，也可能是数组）
For i = 0 To UBound(rng)
If Not IsMissing(rng(i)) Then '如果有参数
Select Case TypeName(rng(i)) '根据参数的类型决定计算方式
Case "Range" '如果是单元格
'如果参数设置过大，仅仅对参数与已用区域的重叠部分进行计算
Set celll = Application.Intersect(rng(i), ActiveSheet.UsedRange)
For Each cell In celll '遍历单元格区域
Connect = Connect & cell '串连所有单元格字符
Next cell
Case "Variant()" '如果是数组（包括内存数组）
For Each cellv In rng(i) '遍历数组
'跳过False，将数组中其它元素串连
If cellv <> False Then Connect = Connect & cellv
Next cellv
Case Else '否则
Connect = Connect & rng(i) '直接连接（指直接在参数中输入的字符串）
End Select
End If
Next i
End Function
Function Functions(ParamArray rng() As Variant) '声明函数名称，有多个可选参数，包括1到255个
Dim cell, Fun_count As Long, i As Byte, celll As Range '声明变量
Application.Volatile '声明为易失性函数
If UBound(rng) = -1 Then Functions = 0: Exit Function '如果无参数则结果为0
For i = 0 To UBound(rng) '遍历每个参数
If Not IsMissing(rng(i)) Then '如果有参数
Set celll = Application.Intersect(rng(i), ActiveSheet.UsedRange)
For Each cell In celll '遍历区域中每个元素
If cell.HasFormula Then Fun_tion = Fun_tion + 1 '如果有公式则累加变量
Next cell
End If
Next i
Functions = Fun_tion '统计结果
End Function
Function AverageIfcol(条件区 As Range, 颜色单元格 As Range, Optional 统计区) '声明函数名称，有三个参数，第三个是可选参数
Dim i As Integer, counts As Integer, rng As Range, sum As Double '声明变量
Application.Volatile '声明为易失性函数
If IsMissing(统计区) Then Set rng = 条件区 '如果第三参数被忽略，则将条区赋与rng变量
'如果未被忽略，那么以统计区第一个单元格为基准，向下扩充到条件区同等大于的区域赋与变量Rng
If Not IsMissing(统计区) Then Set rng = 统计区(1).Resize(条件区.Rows.Count, 条件区.Columns.Count)
For i = 1 To 条件区.Count '遍历条件区
'如果条件区中某个单元格背景色与颜色单元格区域（参照区）颜色一致，那么
If 条件区(i).Interior.Color = 颜色单元格(1).Interior.Color Then
sum = sum + rng(i).Value '累加符合条件的数据
counts = counts + 1 '统计符合条件的个数
End If
Next i
AverageIfcol = sum / counts '最后结果等于总和除以个数
End Function
----------------------------------------------------------------------------------------------
'声明函数名称，有三个参数，第三个是可选参数,函数的结果是数组
Function VlookupCol(查找值 As Range, 查找区域 As Range, Optional 列数 As Byte = 2) As Variant
Dim Col As Long, cell As Range, arr(), i As Byte '声明变量
Application.Volatile '声明为易失性函数
Col = 查找值.Interior.Color '获取参照单元格的背景色
'遍历查找区域的最左边一列
For Each cell In 查找区域(1).Resize(查找区域.Rows.Count, 1)
If cell.Interior.Color = Col Then '如果与参照颜色一致
i = i + 1 '累加变量
ReDim Preserve arr(1 To i) '重新声明数据大小，且保持数组原数据
arr(i) = cell.Offset(0, 列数 - 1) '将找到的单元格右边对应的数值赋与数组
End If
Next cell
VlookupCol = WorksheetFunction.Transpose(arr) '将数组的结果赋与函数
End Function
-----------------------------------------------------------------------------------------------
Function SFZ(cell As Range, Optional Options As String = "XB") As String '提取性别
Application.Volatile
Dim temp As String
If cell = "" Then SFZ = "": Exit Function
If Len(cell.Text) <> 15 And Len(cell.Text) <> 18 Then SFZ = "": Exit Function
If Options = "" Or (UCase(Options) <> "NL" And UCase(Options) <> "SR" And UCase(Options) <> "XB") Then SFZ = "": Exit Function
If UCase(Options) = "XB" Then SFZ = VBA.IIf((Mid(cell.Text, 15, 3) Mod 2), "男", "女"): Exit Function
If Len(cell.Text) = 15 And Mid(cell.Text, 7, 1) = 0 Then SFZ = "20" & Mid(cell.Text, 7, 2) & "-" & Mid(cell.Text, 9, 2) & "-" & Mid(cell.Text, 11, 2)
If Len(cell.Text) = 15 And Mid(cell.Text, 7, 1) > 0 Then SFZ = "19" & Mid(cell.Text, 7, 2) & "-" & Mid(cell.Text, 9, 2) & "-" & Mid(cell.Text, 11, 2)
If Len(cell.Text) = 18 Then SFZ = Mid(cell.Text, 7, 4) & "-" & Mid(cell.Text, 11, 2) & "-" & Mid(cell.Text, 13, 2)
If UCase(Options) = "NL" Then
Dim dat As Date
dat = DateSerial(VBA.Split(SFZ, "-")(0), VBA.Split(SFZ, "-")(1), VBA.Split(SFZ, "-")(2))
SFZ = Application.Evaluate("DATEDIF(" & dat * 1 & ", NOW()," & """Y""" & ")")
End If
End Function
Sub 从身份证号码获取信息()
Dim rng As Range, i As Integer
Set rng = Application.InputBox("请选择区域：", "确定计算区域", IIf(TypeName(Selection) = "Range", Selection.Address(0, 0), ""), , , , , 8)
If rng.Columns.Count > 1 Then MsgBox "不能选择一列以上", 64, "出错提示": Exit Sub
If rng(1) = "" Then MsgBox "请选择身份证号码存放区域", 64, "出错提示": Exit Sub
Application.ScreenUpdating = False
For i = 1 To rng.Count
rng(i).Offset(0, 1) = SFZ(rng(i), "nl")
rng(i).Offset(0, 2) = SFZ(rng(i), "sr")
rng(i).Offset(0, 3) = SFZ(rng(i))
Next i
Application.ScreenUpdating = True
End Sub
Sub auto_Open()
On Error Resume Next
auto_close
With Application.CommandBars("cell").Controls.Add(msoControlButton, 1, , 3, True)
.Caption = "批量获取身份证信息(&P)"
.OnAction = "从身份证号码获取信息"
.Style = msoButtonIconAndCaption
.FaceId = 263
End With
End Sub
Sub auto_close()
On Error Resume Next
Application.CommandBars("cell").Controls("批量获取身份证信息(P)").Delete
End Sub
-----------------------------------------------------------------------------------------------
*******VBA宏程序********
'Like用法(输入小写字母限定宏)
Private Sub TextBox1_Change()
If Len(TextBox1.Text) > 0 Then
If Right(TextBox1.Text, 1) Like "[a-z]" Then Exit Sub Else Me.TextBox1 = Left(TextBox1.Text, Len(TextBox1.Text) - 1)
End If
End Sub
'Private Sub TextBox1_Change()
' If Len(TextBox1.Text) > 0 Then
' If Right(TextBox1.Text, 1) Like "[4-8D-G]" Then Exit Sub Else Me.TextBox1 = Left(TextBox1.Text, Len(TextBox1.Text) - 1)
' End If
'End Sub
-------------------------------------------------------------------------------------------------
Sub 姓名(name As String) '确认权限
Dim i As Byte, rng As Range
For i = 1 To Sheets.Count
If ThisWorkbook.Sheets(i).name = "许可人员列表" Then: GoTo OK
Next i
MsgBox "不存在“许可人员列表”", 64
Exit Sub
OK:
If Len(name) < 2 Or Len(name) > 4 Then MsgBox "长度只能2到4,请重新录入", 64: Exit Sub
Set rng = ThisWorkbook.Sheets("许可人员列表").Range("a1:a10").Find(name)
If rng Is Nothing Then MsgBox "你无操作权限" Else MsgBox "你具有操作权限"
End Sub
Sub 确认权限一() '手工指定姓名
Call 姓名(Application.InputBox("请输入您的姓名", "确认权限", "", , , , , 2))
End Sub
Sub 确认权限二() '以当前表A1的值进行判断
Call 姓名(ActiveSheet.Range("A1"))
End Sub
Sub 确认权限三() '以OFFICE安装用户名进行判断
Call 姓名(Application.UserName)
End Sub
------------------------------------------------------------------------------------------------
Sub 合并三个班成绩到总表()
Dim sht As Worksheet '声明变量
Sheets("汇总表").Select
For Each sht In Sheets '遍历所有工作表
If sht.Name <> ActiveSheet.Name Then '如果sht的名字不等于当前表名字
'如果工作表A列非空（本程序要求工作表的数据必须从A列开始存放）
If WorksheetFunction.CountA(sht.[a:a]) > 0 Then
'将工作表sht中A1到最后一个非空行之间的所有行复制到当前表的从上到下第一个空行
sht.[a1].Resize(sht.Cells(Rows.Count, 1).End(xlUp).Row, Columns.Count).Copy _
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(Len([a1]) > 0, 0)
End If
End If
Next sht '复制下一个
End Sub
------------------------------------------------------------------------------------------------
Sub 复制数据() '从Sheet2复制数据到当前工作表空白区域中
With Sheet2.UsedRange 'With减少对象的引用次数
'利用Offset取得当前表已用区域之后第一个空白单元格，配合Resize将区域重置为与Sheet2标题以外的数据一样大小
'然后将两个相同大小的区域直接赋值即可。但在赋值时需要注意一个问题：Value不能省略
ActiveSheet.UsedRange.Cells(1, 1).Offset(ActiveSheet.UsedRange.Rows.Count).Resize(.Rows.Count - 2, .Columns.Count) = .Offset(2, 0).Resize(.Rows.Count - 2, .Columns.Count).Value
End With
ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous '对已用区域添加边框
End Sub
-------------------------------------------------------------------------------------------------
Sub 隔一行插入N行()
Application.ScreenUpdating = False '关闭屏幕刷新
Dim i As Integer, Row_Count As Byte '声明变量
Row_Count = InputBox("隔行插入几行？", "确定行数", 1) '用户指定插行的行数
For i = 20 To 1 Step -1 '从最大值循环至第一行
Cells(i, 1).Resize(Row_Count * 1, 1).EntireRow.Insert Shift:=xlDown '插入行
Next i
[a1].Resize(Row_Count * 1, 1).EntireRow.Delete '删除第一行前插入的行
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
--------------------------------------------------------------------------------------------------
Sub 工作表减肥()
MsgBox "减肥前：" & ActiveSheet.UsedRange.Address '获取减肥前的已用区域地址
'清除多余的列
Dim Col_Count As Long
With ActiveSheet.UsedRange '使用With简化对象引用
For Col_Count = .Columns.Count To 1 Step -1 '从已用区域最后一列开始，直到第一列
'如果循环中某单元格整列皆为空白
'（Resize方法的作用是使用For只在已用区域的第一行循环，忽略其它行，提升代码效率）
If WorksheetFunction.CountA(.Item(1).Resize(1, .Columns.Count)(Col_Count).EntireColumn) = 0 Then
'将该列删除
.Item(1).Resize(1, .Columns.Count)(Col_Count).EntireColumn.Delete
Else '否则
Exit For '只要该列有一个数据则退出循环，避免删除必要的空列
End If
Next
End With
'清除多余的行
Dim Row_Count As Long
With ActiveSheet.UsedRange '使用With简化对象引用
For Row_Count = .Rows.Count To 1 Step -1 '从已用区域最后一行开始，直到第一行
'如果循环中某单元格整行皆为空白
'（Resize方法的作用是使用For只在已用区域的第一列循环，忽略其它列，提升代码效率）
If WorksheetFunction.CountA(.Item(1).Resize(.Rows.Count, 1)(Row_Count).EntireRow) = 0 Then
'将该列删除
.Item(1).Resize(.Rows.Count, 1)(Row_Count).EntireRow.Delete
Else '否则
Exit For '只要该列有一个数据则退出循环，避免删除必要的空列
End If
Next
End With
endd:
MsgBox "减肥后：" & ActiveSheet.UsedRange.Address '报告减肥后的已用区域地址
End Sub
------------------------------------------------------------------------------------------------
Sub 数据交换()
Dim rng As Range, adds As String, i As Byte, j As Byte, rngg
'获取所有姓名所在地址
For Each rng In ActiveSheet.UsedRange.Item(1).Resize(1, ActiveSheet.UsedRange.Columns.Count)
If rng = "姓名" Then adds = adds & rng.Address(0, 0) & ","
Next rng
With Range(Left(adds, Len(adds) - 1))
'统计组别个数
j = .Areas.Count
'将最后一个区域的值存入内存中
rngg = .Areas(1).CurrentRegion
For i = 1 To j - 1 '遍历最后一个区或以外的所有区域
'将下一个区域的值赋于当于区域
.Areas(i).CurrentRegion = .Areas(i + 1).CurrentRegion.Value
Next i
.Areas(j).CurrentRegion = rngg '再将内存中的值赋于最后一个区域
End With
End Sub
-------------------------------------------------------------------------------------------------
Sub 数据交换() 'Offset应用
Dim rng As Range, adds As String, i As Byte, j As Byte, rngg
'获取所有姓名所在地址
For Each rng In ActiveSheet.UsedRange.Resize(1, ActiveSheet.UsedRange.Columns.Count)
If Len(rng) > 0 Then adds = adds & rng.Address(0, 0) & ","
Next rng
With Range(Left(adds, Len(adds) - 1))
'统计组别个数
j = .Areas.Count
'将最后一个区域的值存入内存中,Offset的作用是向下偏移一行，从而避免移动标题
rngg = .Areas(1).CurrentRegion.Offset(1)
For i = 1 To j - 1 '遍历最后一个区或以外的所有区域
'将下一个区域的值赋于当于区域
.Areas(i).CurrentRegion.Offset(1) = .Areas(i + 1).CurrentRegion.Offset(1).Value
Next i
.Areas(j).CurrentRegion.Offset(1) = rngg '再将内存中的值赋于最后一个区域
End With
End Sub
-------------------------------------------------------------------------------------------------
Sub 数据交换()
Dim rng As Range, adds As String, i As Byte, j As Byte, rngg
'获取所有姓名所在地址
For Each rng In ActiveSheet.UsedRange.Item(1).Resize(1, ActiveSheet.UsedRange.Columns.Count)
If rng = "姓名" Then adds = adds & rng.Address(0, 0) & ","
Next rng
With Range(Left(adds, Len(adds) - 1))
'统计组别个数
j = .Areas.Count
'将最后一个区域的值存入内存中
rngg = .Areas(1).CurrentRegion
For i = 1 To j - 1 '遍历最后一个区或以外的所有区域
'将下一个区域的值赋于当于区域
.Areas(i).CurrentRegion = .Areas(i + 1).CurrentRegion.Value
Next i
.Areas(j).CurrentRegion = rngg '再将内存中的值赋于最后一个区域
End With
End Sub
-------------------------------------------------------------------------------------------------
Sub 行列自动合计()
'先汇总各行的值
For i = 1 To Selection.Rows.Count '从1到总行数
'利用Offset取得汇总数据的放置位置，即选区第一个单元格向右偏移选区的列数
'合计区域也用Offset逐行偏量来获取，Resize的作用是重置为1行，否则会汇总其它行的数据
Selection(1).Offset(i - 1, Selection.Columns.Count) = WorksheetFunction.Sum(Selection.Offset(i - 1).Resize(1))
Next
'再汇总各列的值
For i = 1 To Selection.Columns.Count + 1 '从1到总列数加1,因为需要对行的汇总数再进行汇总
Selection(1).Offset(Selection.Rows.Count, i - 1) = WorksheetFunction.Sum(Selection.Offset(, i - 1).Resize(, 1))
Next
End Sub
-------------------------------------------------------------------------------------------------
********自动宏*********
Option Explicit
'声明工作表事件
Private Sub Worksheet_Change(ByVal Target As Range)
'如果只在一个单元格中编辑数据就执行事件过程
If Target.Count = 1 Then
'使用Cells参数Columns.Count是为了兼容Excel 2003，Target.Row + 1则表示下一行
With Cells(Target.Row + 1, Columns.Count).End(xlToLeft)
'自动选择下一行第一个非空单元格
.Offset(0, -(Len(.Text) > 0)).Select
End With
End If
End Sub
--------------------------------------------------------------------------------------------------
Sub 批量打开文件()
Dim fd As FileDialog, Item As Integer
'弹出一个浏览文件的窗口，可以多选目标文件
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'如果选择了文件
If fd.Show = -1 Then
'遍历所有文件
For Item = 1 To fd.SelectedItems.Count
'逐个打开文件
Workbooks.Open (fd.SelectedItems(Item))
Next Item
End If
End Sub
--------------------------------------------------------------------------------------------------
Public WithEvents app As Application '声明可触发事件的对象变量
Private Sub app_NewWorkbook(ByVal Wb As Workbook) '声明应用程序事件
Dim i As Byte
Wb.Sheets.Add , , 7 - Sheets.Count '创建4个工作表（默认有3个）
Wb.Sheets(1).Name = "总表" '将第一个命名为总表
For i = 2 To Wb.Sheets.Count '从第二开始 直到最后一个
Wb.Sheets(i).Name = "分表" & i - 1 '改名为“分表”加编号
Next
End Sub
--------------------------------------------------------------------------------------------------
Private Sub Workbook_BeforePrint(Cancel As Boolean)
With ActiveSheet.PageSetup '设置页面
.LeftHeader = "&D" '页眉左边插入日期
.CenterHeader = "" '中间空白
.RightHeader = "第&P页总&N页" '右边显示页数
End With
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
With ActiveSheet.PageSetup '设置页面
.LeftHeader = "&D" '页眉左边插入日期
.CenterHeader = "" '中间空白
.RightHeader = "第&P页总&N页" '右边显示页数
End With
End Sub
-------------------------------------------------------------------------------------------------
Sub 获取CD磁盘空间()
MsgBox "C盘:" & String(6, " ") & (CreateObject("SCRIPTING.FILESYSTEMOBJECT").GETDRIVE("C:").TOTALSIZE / 1024) & "MB" & Chr(10) & "D盘:" & String(6, " ") & (CreateObject("SCRIPTING.FILESYSTEMOBJECT").GETDRIVE("D:").TOTALSIZE / 1024) & "MB" & Chr(10) & "E盘:" & String(6, " ") & (CreateObject("SCRIPTING.FILESYSTEMOBJECT").GETDRIVE("E:").TOTALSIZE / 1024) & "MB" & Chr(10) & "F盘:" & String(6, " ") & (CreateObject("SCRIPTING.FILESYSTEMOBJECT").GETDRIVE("F:").TOTALSIZE / 1024) & "MB" & Chr(10)
End Sub
