VBA 自动创建带格式的月份工作表与超链接
★ 创建一个Excel表格
1）选择“开发工具”选项，打开VBA编辑器，创建一个模块；
2）将下面的代码全部复制到新建的模块中；
3）在Excel表格界面，选择“开发工具”选项，点选“宏”，也就是查看宏；
4）在查看宏界面，依照宏名称后面的数字编号依次点选之，再点击“执行”按钮；
5）需要多次，查看宏、选择、执行，即可完成自动创建带格式的月份工作表的工作；
6）保存你的创建，需要保存成“Excel 启用宏的工作簿（*.xlsm）”的文件；
‘’‘’ 自动创建带格式的月份工作表的全部代码如下：
Public Sub 创建带格式月份表——1()
Dim i As Integer
Dim ws As Worksheet
Dim baseSheet As Worksheet
Dim sheetName As String
Dim headers As Variant
Dim colWidths As Variant
Dim j As Integer
Dim xTmonth As Variant
'''' 定义标题数约l和列宽配置
headers = Array("序号", "名称", "型号", "规格", "单位", "单价", "数量", "金额", "描述", "目 录")
xTmonth = Array("〇", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十", "十一", "十二")
colWidths = Array(6, 20, 15, 15, 8, 10, 8, 12, 24) '''' 对应A—I列
Application.ScreenUpdating = False
Application.DisplayAlerts = Faise
Set baseSheet = ThisWorkbook.Sheets(1)
For i = 1 To 12
sheetName = xTmonth(i) & "月份"
'''' 删除已存在的同名工作表
On Error Resume Next
ThisWorkbook.Sheets(sheetName).Delete
On Error GoTo 0
'''' 创建新表
Set ws = ThisWorkbook.Sheets.Add(After:=baseSheet)
With ws
.Name = sheetName
.Tab.Color = RGB(100 + i * 10, 150, 200) '''' 设置1到12月渐变色
'''' 设置标题行
With .Range("A1:J1, A1:A101")
.Value = headers
.Font.Bold = True
.Interior.Color = RGB(255, 169, 0) '''' 设置标题和序号的单元格填充色为橙色：255, 169, 0
.HorizontalAlignment = xlCenter '''' 水平居中
.VerticalAlignment = xlCenter '''' 垂直居中
.RowHeight = 18.75 '''' 设置行高
.Borders.LineStyle = xlContinuous '''' 添加边框
.Borders.Color = RGB(0, 0, 0)
End With
''''设置列宽（正确方式）
For j = 0 To UBound(colWidths)
.Columns(j + 1).ColumnWidth = colWidths(j)
Next j
'''' 冻结首行
.Activate
With ActiveWindow
.FreezePanes = False
.SplitRow = 1
.FreezePanes = True
End With
'''' 添加序号公式及边框
With .Range("A2:I101") '''' 预置数据区域
.Borders.LineStyle = xlContinuous
.Borders.Color = RGB(0, 0, 0) '''' 设置边框i颜色
.Rows(1).Offset(1, 0).Borders(1).Weight = xlThin
End With
'''' 序号自动填充
.Range("A2").Formula = "=ROW()-1" '''' 从A2单元格开始填充序列号
.Range("A2").AutoFill Destination:=.Range("A2:A101") '''' 填充区域设置：从A2到A101单元格
.Range("A1:I101").Borders.Color = RGB(0, 0, 0) '''' 设置A2到A101单元格边框颜色：0, 0, 0
End With
Set baseSheet = ws
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "12个月份的表格已创建，含标准化格式!"
'''' 焦点转移到Sheet1表格的B2单元格
Sheets("Sheet1").Select
Range("B2").Select
End Sub
Public Sub 获取所有工作表名称——2()
Dim ai As Long
Dim ws As Worksheet, xNT As String
xNT = ActiveSheet.Name
If xNT = "Sheet1" Then Sheets("Sheet1").Name = "目 录"
For Each ws In ThisWorkbook.Worksheets
ai = Val(ai) + 1
Cells(ai + 1, 3).Value = ws.Name ''''’ 各工作表名称放在从第二行开始的第三列的区域
Cells(ai + 1, 3).RowHeight = 18.75
Next ws
Cells(1, 3).Value = "所有工作表名称"
Cells(1, 3).ColumnWidth = 13.75
Cells(1, 3).RowHeight = 18.75
' 文字居中 宏
Range("C1:C14").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(2, 3).Select
End Sub
Sub 创建目录项与表格的超链接——3()
'
' 适合于本表格的表格超链接 宏
Dim i As Long
Dim xTmonth As Variant
xTmonth = Array("〇", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十", "十一", "十二")
Dim xWsBname As String
For i = 1 To 12
xWsBname = xTmonth(i) & "月份"
Range("C" & i + 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
xWsBname & "!A1", TextToDisplay:=xWsBname
Next i
For i = 1 To 12
xWsBname = xTmonth(i) & "月份"
Sheets(xWsBname).Select
Range("J1").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"'目 录'!A1", TextToDisplay:="目 录"
Next i
MsgBox "所有目录项与表格的超链接，创建完成！", vbInformation, "提示"
Sheets("目 录").Select
Range("C2").Select
End Sub