Excel VBA 宏自动创建表格

Excel VBA 宏 - 自动创建表格

应朋友的需求，编写了一个 VBA 宏，用于自动创建工作簿，实现了排版布局、冻结表头、条件格式、自动求和、单元格保护等功能。

分别创建了 4 个工作簿 1-12月流水帐+库存表、1-12月银行现金日记账、1-12月商品进货单、单一帐目表，用于小公司记账比较方便。

Sub Main()
  Call 创建流水账("商品销售流水账_自动创建")
  
  Call 创建日记账("银行现金日记账_自动创建")
  
  Call 创建进货单("某某商品进货单_自动创建")

  Call 创建单表("某某帐目_自动创建", "某某帐目")
End Sub


' 创建流水账表格
' name = 文件名
Sub 创建流水账(name As String)
  ' 创建工作薄（可能会创建在当前目录或“我的文档”目录）
  Dim wb As Workbook
  Set wb = NewWorkbook(".\" & name)

  ' 只保留一个工作表
  Dim ws As Worksheet
  Set ws = ClearSheets(wb)

  ' 设置所有单元格格式
  With Cells
    .RowHeight = 30                            ' 设置行高
    .Font.Size = 12                            ' 设置字体
    .HorizontalAlignment = xlCenter            ' 水平居中
    .VerticalAlignment = xlCenter              ' 竖直居中
    .WrapText = True                           ' 自动换行
  End With
  
  ' 绘制表格
  Call DrawTable(ws, "A1", "2023 年 1 月商品销售表", "日期 名称 成本价 成交价 毛利润 备注", "9 28 12 12 12 30", 500)

  ' 绘制表格
  Call DrawTable(ws, "H1", "2023 年 1 月经营费用表", "日期 收支 备注", "9 12 30", 500)

  ' 表格之间的间距
  Columns(7).ColumnWidth = 1

  ' 设置单元格格式
  Call DateFormat(Range("A4:A500"))            ' 日期格式，居中
  Call DateFormat(Range("H4:H500"))            ' 日期格式，居中
  
  Call TextFormat(Range("B4:B500"), False)     ' 文本格式，不居中
  Call TextFormat(Range("F4:F500"), False)     ' 文本格式，不居中
  Call TextFormat(Range("J4:J500"), False)     ' 文本格式，不居中

  Call NamedNumFormat(Range("B2"), "平均利润") ' 带前缀数值格式，居中

  ' 填写公式
  Range("B2").Value = "=(E2+I2)/2"             ' 平均利润，总利润除以合伙人数量，这里除以 2
  Range("C2:E2").Value = "=SUM(C4:C500)"       ' 成本/成交/利润
  Range("I2").Value = "=SUM(I4:I500)"          ' 收支
  Range("E5:E500").Value = "=D5-C5"            ' 收支

  ' 设置公式结果为粗体
  FormulasCells(ws).Font.Bold = True
  ' 设置公式单元格颜色（锁定状态的颜色，亮色）
  Call LightBGColor(FormulasCells(ws))

  ' 设置条件格式
  Call FormatCondition(Range("B2"), False, False, True)       ' 平均利润
  
  Call FormatCondition(Range("C2:D2"), False, True, True)     ' 成本/成交
  Call FormatCondition(Range("C4:D500"), False, True, False)  ' 成本/成交
  
  Call FormatCondition(Range("E2"), True, False, True)        ' 利润
  Call FormatCondition(Range("E4:E500"), True, False, True)   ' 利润
  Call FormatCondition(Range("I2"), True, False, True)        ' 收支
  Call FormatCondition(Range("I4:I500"), True, False, True)   ' 收支

  ' 冻结表格
  Call FreezeTable(Range("A4"))

  ' 取消锁定（用户可编辑区域）
  Call UnLockCell(Range("A1:F1"))
  Call UnLockCell(Range("H1:J1"))
  Call UnLockCell(Range("F2"))
  Call UnLockCell(Range("J2"))
  Call UnLockCell(Range("A5:D500"))
  Call UnLockCell(Range("F5:F500"))
  Call UnLockCell(Range("H5:J500"))

  ' 保护工作表
  Call ProtectSheet(ws, "123")
  
  ' 复制出 12 个月的工作表
  ws.name = "1月"
  For i = 2 To 12
    ws.Copy After:=ws                          ' 拷贝当前工作表到其之后的位置
    Set ws = wb.ActiveSheet                    ' 设置新工作表为当前工作表
    ws.name = i & "月"                         ' 修改工作表标签名
    ' 修改表格标题
    ws.Range("A1").Value = "2023 年 " & i & " 月商品销售表"
    ws.Range("H1").Value = "2023 年 " & i & " 月经营费用表"
  Next
  
  ' 创建库存表
  Sheets.Add After:=ws                         ' 添加新工作表
  Set ws = wb.ActiveSheet                      ' 设置新工作表为当前工作表
  ws.name = "库存"

  ' 设置所有单元格格式
  With Cells
    .RowHeight = 30                            ' 设置行高
    .Font.Size = 12                            ' 设置字体
    .HorizontalAlignment = xlCenter            ' 水平居中
    .VerticalAlignment = xlCenter              ' 竖直居中
    .WrapText = True                           ' 自动换行
  End With
  
  ' 绘制表格（库存表）
  Call DrawTable(ws, "A1", "2023 年商品库存表", "日期 名称 成本 备注", "9 50 16 50", 500)

  ' 设置单元格格式
  Call DateFormat(Range("A4:A500"))            ' 日期格式，居中
  
  Call TextFormat(Range("B4:B500"), False)     ' 文本格式，不居中
  Call TextFormat(Range("D4:D500"), False)     ' 文本格式，不居中
  
  ' 填写公式
  Range("C2").Value = "=SUM(C4:C500)"

  ' 设置公式结果为粗体
  FormulasCells(ws).Font.Bold = True
  ' 设置公式单元格颜色（锁定状态的颜色，亮色）
  Call LightBGColor(FormulasCells(ws))

  ' 设置条件格式
  Call FormatCondition(Range("C2"), True, False, True)      ' 成本
  Call FormatCondition(Range("C4:C500"), True, False, True) ' 成本

  ' 冻结表格
  Call FreezeTable(Range("A4"))

  ' 取消锁定（用户可编辑区域）
  Call UnLockCell(Range("A1:D1"))
  Call UnLockCell(Range("B2"))
  Call UnLockCell(Range("D2"))
  Call UnLockCell(Range("A5:D500"))

  ' 保护工作表
  Call ProtectSheet(ws, "123")
  
  ' 激活 1 月工作表
  wb.Sheets(1).Activate
  
  ' 保存工作表
  Call SaveWorkbook(wb)
  Call CloseWorkbook(wb)
End Sub


' 创建日记账表格
' name = 文件名
Sub 创建日记账(name As String)
  ' 创建工作薄（可能会创建在当前目录或“我的文档”目录）
  Dim wb As Workbook
  Set wb = NewWorkbook(".\" & name)

  ' 只保留一个工作表
  Dim ws As Worksheet
  Set ws = ClearSheets(wb)

  ' 设置所有单元格格式
  With Cells
    .RowHeight = 30                            ' 设置行高
    .Font.Size = 12                            ' 设置字体
    .HorizontalAlignment = xlCenter            ' 水平居中
    .VerticalAlignment = xlCenter              ' 竖直居中
    .WrapText = True                           ' 自动换行
  End With
  
  ' 绘制表格
  Call DrawTable(ws, "A1", "2023 年 1 月银行日记账", "日期 凭证号 收入 支出 余额 备注", "9 13 12 12 12 18", 500)
  Call RedBGColor(Range("A1"))                 ' 表头红色

  ' 绘制表格
  Call DrawTable(ws, "H1", "2023 年 1 月现金日记账", "日期 凭证号 收入 支出 余额 备注", "9 13 12 12 12 18", 500)
  Call OrangeBGColor(Range("H1"))              ' 表头橙色

  ' 表格之间的间距
  Columns(7).ColumnWidth = 1

  ' 设置单元格格式
  Call DateFormat(Range("A4:A500"))            ' 日期格式，居中
  Call DateFormat(Range("H4:H500"))            ' 日期格式，居中
  
  Call TextFormat(Range("B4:B500"), True)      ' 文本格式，居中
  Call TextFormat(Range("I4:I500"), True)      ' 文本格式，居中
  
  Call NumFormat(Range("C4:E500"), False)      ' 数值格式，居中
  Call NumFormat(Range("J4:L500"), False)      ' 数值格式，居中
  
  Call TextFormat(Range("F4:F500"), False)     ' 文本格式，不居中
  Call TextFormat(Range("M4:M500"), False)     ' 文本格式，不居中

  ' 填写公式
  Range("C2:E2").Value = "=SUM(C4:C500)"       ' 收入/支出/余额
  Range("J2:L2").Value = "=SUM(J4:J500)"       ' 收入/支出/余额
  Range("E5:E500").Value = "=C5-D5"            ' 余额
  Range("L5:L500").Value = "=J5-K5"            ' 余额

  ' 设置公式结果为粗体
  FormulasCells(ws).Font.Bold = True
  ' 设置公式单元格颜色（锁定状态的颜色，亮色）
  Call LightBGColor(FormulasCells(ws))

  ' 设置条件格式
  Call FormatCondition(Range("C2:D2"), False, True, True)    ' 收入/支出（不可为负）
  Call FormatCondition(Range("E2"), True, False, True)       ' 收入/支出（负数红色，零无色）
  
  Call FormatCondition(Range("C4:D500"), False, True, False) ' 收入/支出（不可为负）
  Call FormatCondition(Range("E4:E500"), True, False, True)  ' 收入/支出（负数红色，零无色）
  
  Call FormatCondition(Range("J2:K2"), False, True, True)    ' 收入/支出（不可为负）
  Call FormatCondition(Range("L2"), True, False, True)       ' 收入/支出（负数红色，零无色）
  
  Call FormatCondition(Range("J4:L500"), False, True, False) ' 收入/支出（不可为负）
  Call FormatCondition(Range("L4:L500"), True, False, True)  ' 收入/支出（负数红色，零无色）

  ' 冻结表格
  Call FreezeTable(Range("A4"))

  ' 取消锁定（用户可编辑区域）
  Call UnLockCell(Range("A1:F1"))
  Call UnLockCell(Range("H1:M1"))
  
  Call UnLockCell(Range("B2"))
  Call UnLockCell(Range("F2"))
  Call UnLockCell(Range("I2"))
  Call UnLockCell(Range("M2"))
  
  Call UnLockCell(Range("A5:D500"))
  Call UnLockCell(Range("F5:F500"))
  
  Call UnLockCell(Range("H5:K500"))
  Call UnLockCell(Range("M5:M500"))

  ' 保护工作表
  Call ProtectSheet(ws, "123")
  
  ' 复制出 12 个月的工作表
  ws.name = "1月"
  For i = 2 To 12
    ws.Copy After:=ws                          ' 拷贝当前工作表到其之后的位置
    Set ws = wb.ActiveSheet                    ' 设置新工作表为当前工作表
    ws.name = i & "月"                         ' 修改工作表标签名
    ' 修改表格标题
    ws.Range("A1").Value = "2023 年 " & i & " 月银行日记账"
    ws.Range("H1").Value = "2023 年 " & i & " 月现金日记账"
  Next
  ' 激活 1 月工作表
  wb.Sheets(1).Activate
  
  ' 保存工作表
  Call SaveWorkbook(wb)
  Call CloseWorkbook(wb)
End Sub


' 创建进货单表格（生成后，可以通过修改最后一个表格中的参数来更新所有表格的标题）
' name = 文件名
Sub 创建进货单(name As String)
  ' 创建工作薄（可能会创建在当前目录或“我的文档”目录）
  Dim wb As Workbook
  Set wb = NewWorkbook(name)

  ' 只保留一个工作表
  Dim ws As Worksheet
  Set ws = ClearSheets(wb)

  ' 设置所有单元格格式
  With ws.Cells
    .RowHeight = 30                            ' 设置行高
    .Font.Size = 12                            ' 设置字体
    .HorizontalAlignment = xlCenter            ' 水平居中
    .VerticalAlignment = xlCenter              ' 竖直居中
    .WrapText = True                           ' 自动换行
  End With

  ' 绘制表格
  Call DrawTable(ws, "A1", "2023 年 1 月某某商品进货单", "日期 编号 金额 备注", "9 26 12 50", 500)

  ' 设置单元格格式
  Call DateFormat(Range("A4:A500"))            ' 日期格式
  Call TextFormat(Range("B4:B500"), True)      ' 文本格式，居中
  Call TextFormat(Range("D4:D500"), False)     ' 文本格式，不居中

  ' 填写公式
  Range("C2").Value = "=SUM(C4:C500)"

  ' 设置公式结果为粗体
  FormulasCells(ws).Font.Bold = True
  ' 设置公式单元格颜色（锁定状态的颜色，亮色）
  Call LightBGColor(FormulasCells(ws))

  ' 设置条件格式
  Call FormatCondition(Range("C4:C500"), True, False, False)  ' 小于 0 红色文本
  Call FormatCondition(Range("C2"), True, False, True)        ' 小于 0 红色文本，等于 0 无颜色

  ' 冻结表格
  Call FreezeTable(Range("A4"))

  ' 取消锁定（用户可编辑区域）
  Call UnLockCell(Range("B2"))
  Call UnLockCell(Range("D2"))
  Call UnLockCell(Range("A5:D500"))

  ' 复制出 12 个月的工作表
  ws.name = "1月"
  For i = 2 To 12
    ws.Copy After:=ws                          ' 拷贝当前工作表到其之后的位置
    Set ws = wb.ActiveSheet                    ' 设置新工作表为当前工作表
    ws.name = i & "月"                         ' 修改工作表标签名
  Next

  ' 创建参数表
  wb.Sheets.Add After:=ws
  Set ws = wb.ActiveSheet
  ws.name = "参数"

  ' 设置参数表的所有单元格格式
  With ws.Cells
    .RowHeight = 30                            ' 设置行高
    .Font.Size = 12                            ' 设置字体
    .HorizontalAlignment = xlCenter            ' 水平居中
    .VerticalAlignment = xlCenter              ' 竖直居中
    .WrapText = True                           ' 自动换行
  End With

  ' 设置参数表的列宽
  ws.Range("A1").ColumnWidth = 12
  ws.Range("B1").ColumnWidth = 36

  ' 设置参数表内容
  ws.Range("A1:B1").Merge
  ws.Range("A1") = "工作表参数"
  ws.Range("A2") = "表格标题"
  ws.Range("B2") = "某某商品进货单"
  ws.Range("B2").Locked = False

  ' 设置字体
  ws.Range("A1").Font.Size = 18
  ws.Range("A1").Font.Bold = True
  ws.Range("A2").Font.Bold = True

  ' 设置参数表边框
  Call SetBorders(ws.Range("A1:B1"), xlThin, xlMedium)
  Call SetBorders(ws.Range("A2:B2"), xlThin, xlMedium)

  ' 设置参数表背景色
  Call BlueBGColor(ws.Range("A1:B1"))
  Call LightBGColor(ws.Range("A2"))

  ' 保护工作表
  Call ProtectSheet(ws, "123")

  ' 设置工作表标题
  For i = 1 To 12
    Sheets(i).Range("A1").Value = "=""2023 年 " & i & " 月"" & 参数!B2"
    ' 保护工作表
    Call ProtectSheet(Sheets(i), "123")
  Next

  ' 激活 3 月工作表
  wb.Sheets(3).Activate

  ' 保存工作表
  Call SaveWorkbook(wb)
  Call CloseWorkbook(wb)
End Sub


' 创建单表
' name = 文件名
' title = 表格标题
Sub 创建单表(name As String, title As String)
  ' 创建工作薄（可能会创建在当前目录或“我的文档”目录）
  Dim wb As Workbook
  Set wb = NewWorkbook(name)

  ' 只保留一个工作表
  Dim ws As Worksheet
  Set ws = ClearSheets(wb)

  ' 设置所有单元格格式
  With Cells
    .RowHeight = 30                            ' 设置行高
    .Font.Size = 12                            ' 设置字体
    .HorizontalAlignment = xlCenter            ' 水平居中
    .VerticalAlignment = xlCenter              ' 竖直居中
    .WrapText = True                           ' 自动换行
  End With
  
  ' 绘制表格
  Call DrawTable(ws, "A1", title, "日期 名称 金额 备注", "9 35 12 50", 500)

  ' 设置单元格格式
  Call DateFormat(Range("A4:A500"))            ' 日期格式，居中

  Call TextFormat(Range("B4:B500"), False)     ' 文本格式，不居中
  Call TextFormat(Range("D4:D500"), False)     ' 文本格式，不居中

  ' 填写公式
  Range("C2").Value = "=SUM(C4:C500)"

  ' 设置公式结果为粗体
  FormulasCells(ws).Font.Bold = True
  ' 设置公式单元格颜色（锁定状态的颜色，亮色）
  Call LightBGColor(FormulasCells(ws))

  ' 设置条件格式
  Call FormatCondition(Range("C2"), True, False, True)        ' 小于 0 红色文本，等于 0 无颜色
  Call FormatCondition(Range("C4:C500"), True, False, False)  ' 小于 0 红色文本

  ' 冻结表格
  Call FreezeTable(Range("A4"))

  ' 取消锁定（用户可编辑区域）
  Call UnLockCell(Range("A1:D1"))
  Call UnLockCell(Range("B2"))
  Call UnLockCell(Range("D2"))
  Call UnLockCell(Range("A5:D500"))

  ' 保护工作表
  Call ProtectSheet(ws, "123")
  
  ' 设置工作表名称
  ws.name = title
  
  ' 保存工作表
  Call SaveWorkbook(wb)
  Call CloseWorkbook(wb)
End Sub


' 绘制表格
Sub DrawTable(ws As Worksheet, starts As String, title As String, fields As String, widths As String, rows As Integer)
  ' 将字段列表分割为数组
  Dim fieldList() As String
  fieldList() = Split(fields)

  Dim widthList() As String
  widthList() = Split(widths)

  ' 获取字段数
  Dim cols As Integer
  cols = UBound(fieldList) - LBound(fieldList) + 1

  ' 合并单元格（标题）
  Dim rg As Range
  Set rg = Range(starts, Range(starts).Offset(0, cols - 1))
  Call MergeCells(rg)
  rg.Font.Size = 18                            ' 设置字号
  Set rg = Range(starts)
  rg.Value = title                             ' 设置标题
  rg.Font.Bold = True                          ' 设置粗体

  ' 合计
  Set rg = Range(starts).Offset(1, 0)
  With rg
    .Value = "合计"                            ' 文本
    .Font.Bold = True                          ' 加粗
  End With

  ' 表头
  Set rg = Range(starts).Offset(2, 0)
  For i = LBound(fieldList) To UBound(fieldList)
    Columns(i - LBound(fieldList) + rg.Column).ColumnWidth = Val(widthList(i))
    With rg.Offset(0, i - LBound(fieldList))
      .Value = fieldList(i)                    ' 文本
      .Font.Bold = True                        ' 加粗
    End With
  Next

  ' 绘制网格
  Set rg = Range(starts).Offset(1, 0)
  Set rg = Range(rg, rg.Offset(0, cols - 1))
  Call SetBorders(rg, xlThin, xlMedium)

  Set rg = Range(starts).Offset(2, 0)
  Set rg = Range(rg, rg.Offset(rows - 3, cols - 1))
  Call SetBorders(rg, xlThin, xlMedium)

  ' 标题背景色
  Set rg = Range(starts)
  Call BlueBGColor(rg)                         ' 蓝色

  ' 设置单元格颜色（锁定状态的颜色，亮色）
  Set rg = Range(starts).Offset(1, 0)
  Call LightBGColor(rg)                        ' 亮色
  Set rg = Range(starts).Offset(2, 0)
  Set rg = Range(rg, rg.Offset(0, cols - 1))
  Call LightBGColor(rg)                        ' 亮色

  ' 数据首行背景色（便于用户查看当前是否滚动到了行首）
  Set rg = Range(starts).Offset(3, 0)
  Set rg = Range(rg, rg.Offset(0, cols - 1))
  Call TeaBGColor(rg)                         ' 茶色
End Sub


' 创建工作簿，并通过函数返回
Function NewWorkbook(name As String) As Workbook
  Set NewWorkbook = Workbooks.Add              ' 创建工作簿
  Application.DisplayAlerts = False            ' 禁用文件覆盖警告
  NewWorkbook.SaveAs Filename:=name            ' 保存文件
  Application.DisplayAlerts = True             ' 恢复文件覆盖警告
End Function


' 打开工作薄，并通过函数返回
Function OpenWorkbook(name As String) As Workbook
  Set OpenWorkbook = Workbooks.Open(name)      ' 打开工作薄
End Function


' 保存工作薄
Sub SaveWorkbook(wb As Workbook)
  wb.Save
End Sub


' 关闭工作薄
Sub CloseWorkbook(wb As Workbook)
  wb.Close
End Sub


' 删除多余工作表，只保留第一张工作表
Function ClearSheets(wb As Workbook) As Worksheet
  Application.DisplayAlerts = False            ' 禁用删除确认
  For i = wb.Worksheets.Count To 2 Step -1     ' 循环删除工作表
    wb.Worksheets(i).Delete
  Next
  Application.DisplayAlerts = True             ' 恢复删除确认
  Set ClearSheets = wb.Worksheets(1)           ' 返回第一张工作表
End Function


' 合并单元格
Sub MergeCells(rg As Range)
  rg.MergeCells = True
End Sub


' 设置表格线框
Sub SetBorders(rg As Range, innerWeight As Variant, outerWeight As Variant)
  rg.Borders(xlDiagonalDown).LineStyle = xlNone  ' 取消斜边样式
  rg.Borders(xlDiagonalUp).LineStyle = xlNone    ' 取消斜边样式
  With rg.Borders
    .LineStyle = xlContinuous                  ' 线型
    .ColorIndex = 0                            ' 颜色
    .TintAndShade = 0                          ' 色调和阴影
    .Weight = innerWeight                      ' 线宽
  End With

  With rg.Borders(xlEdgeLeft)                  ' 整体左
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = outerWeight
  End With
  With rg.Borders(xlEdgeTop)                   ' 整体左
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = outerWeight
  End With
  With rg.Borders(xlEdgeBottom)                ' 整体左
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = outerWeight
  End With
  With rg.Borders(xlEdgeRight)                 ' 整体左
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = outerWeight
  End With
End Sub


' 设置表格背景色
'
' color 指定颜色值，取值：
' xlThemeColorDark1    白色
' xlThemeColorLight1   黑色
' xlThemeColorDark2    茶色
' xlThemeColorLight2   深蓝色
' xlThemeColorAccent1  蓝色
' xlThemeColorAccent2  红色
' xlThemeColorAccent3  橄榄色
' xlThemeColorAccent4  紫色
' xlThemeColorAccent5  水绿色
' xlThemeColorAccent6  橙色
'
' tint 指定亮度百分比（取值范围在 1 到 -1 之间）
' 一般取值为：正负 0.8、0.6、0.5、0.4、0.35、0.25、0.15、0.05、0
Sub SetBGColor(rg As Range, color As Variant, tint As Double)
  With rg.Interior
    .Pattern = xlSolid                ' 图案类型
    .PatternColorIndex = xlAutomatic  ' 图案样式
    .PatternTintAndShade = 0          ' 图案的色调与阴影
    .ThemeColor = color               ' 颜色
    .TintAndShade = tint              ' 色调与阴影
  End With
End Sub


' 设置亮色背景（-0.05 -0.25 -0.35 -0.45 -0.5）
Sub LightBGColor(rg As Range, Optional tint As Double = -0.05)
  Call SetBGColor(rg, xlThemeColorDark1, tint)
End Sub


' 设置暗色背景（0.5 0.35 0.25 0.15 0.05）
Sub DarkBGColor(rg As Range, Optional tint As Double = 0.5)
  Call SetBGColor(rg, xlThemeColorLight1, tint)
End Sub


' 设置茶色背景（-0.1 -0.25 -0.5 -0.75 -0.9）
Sub TeaBGColor(rg As Range, Optional tint As Double = 0)
  Call SetBGColor(rg, xlThemeColorDark2, tint)
End Sub


' 设置深蓝色背景（0.8 0.6 0.4 -0.25 -0.5）
Sub DarkBlueBGColor(rg As Range, Optional tint As Double = 0.8)
  Call SetBGColor(rg, xlThemeColorLight2, tint)
End Sub


' 设置蓝色背景（0.8 0.6 0.4 -0.25 -0.5）
Sub BlueBGColor(rg As Range, Optional tint As Double = 0.6)
  Call SetBGColor(rg, xlThemeColorAccent1, tint)
End Sub


' 设置红色背景（0.8 0.6 0.4 -0.25 -0.5）
Sub RedBGColor(rg As Range, Optional tint As Double = 0.6)
  Call SetBGColor(rg, xlThemeColorAccent2, tint)
End Sub


' 设置橄榄色背景（0.8 0.6 0.4 -0.25 -0.5）
Sub GreenBGColor(rg As Range, Optional tint As Double = 0.6)
  Call SetBGColor(rg, xlThemeColorAccent3, tint)
End Sub


' 设置紫色背景（0.8 0.6 0.4 -0.25 -0.5）
Sub PurpleBGColor(rg As Range, Optional tint As Double = 0.6)
  Call SetBGColor(rg, xlThemeColorAccent4, tint)
End Sub


' 设置水绿色背景（0.8 0.6 0.4 -0.25 -0.5）
Sub CyanBGColor(rg As Range, Optional tint As Double = 0.6)
  Call SetBGColor(rg, xlThemeColorAccent5, tint)
End Sub


' 设置橙色背景（0.8 0.6 0.4 -0.25 -0.5）
Sub OrangeBGColor(rg As Range, Optional tint As Double = 0.6)
  Call SetBGColor(rg, xlThemeColorAccent6, tint)
End Sub


' 设置单元格格式（日期）
Sub DateFormat(rg As Range)
    rg.NumberFormatLocal = "m""月""d""日"";@"
End Sub


' 设置单元格格式（文本）
Sub TextFormat(rg As Range, center As Boolean)
    rg.NumberFormatLocal = "@"
    If center Then
      rg.HorizontalAlignment = xlCenter         ' 水平居左
    Else
      rg.HorizontalAlignment = xlLeft           ' 水平居左
    End If
End Sub


' 设置单元格格式（数值）
Sub NumFormat(rg As Range, center As Boolean)
  rg.HorizontalAlignment = xlGeneral            ' 水平居左
  rg.NumberFormatLocal = "0.00_ ;[红色]-0.00 "
End Sub


' 设置单元格格式（带前导文本的数值）
Sub NamedNumFormat(rg As Range, prefix As String)
  rg.NumberFormatLocal = """" + prefix + " ""#0.00;[红色]""" + prefix + " ""-#0.00"
End Sub


' 清除条件格式
Sub ClearFormatConditions(rg As Range)
  rg.FormatConditions.Delete
End Sub


' 设置条件格式（零值与背景同色）
' redFG   单元格数值小于 0 时是否使用红色文本
' redBG   单元格数值小于 0 时是否使用红色背景
' noColor 单元格数值等于 0 时是否使文本与背景同色
Sub FormatCondition(rg As Range, redFG As Boolean, redBG As Boolean, noColor As Boolean)
  ' 清除条件格式
  rg.FormatConditions.Delete
  If redFG Then
    ' 设置条件格式（<0 红色字体）
    rg.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=0"
    rg.FormatConditions(rg.FormatConditions.Count).SetFirstPriority
    With rg.FormatConditions(1).Font
      .color = 255
      .TintAndShade = 0
    End With
    rg.FormatConditions(1).StopIfTrue = False
  End If
  If redBG Then
    ' 设置条件格式（<0 红色背景）
    rg.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=0"
    rg.FormatConditions(rg.FormatConditions.Count).SetFirstPriority
    With rg.FormatConditions(1).Interior
      .PatternColorIndex = xlAutomatic
      .color = 255
      .TintAndShade = 0
    End With
    rg.FormatConditions(1).StopIfTrue = False
  End If
  If noColor Then
    ' 设置条件格式（=0 文本与背景同色）
    rg.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=0"
    rg.FormatConditions(rg.FormatConditions.Count).SetFirstPriority
    With rg.FormatConditions(1).Font
      .ThemeColor = xlThemeColorDark1
      .TintAndShade = -4.99893185216834E-02
    End With
    rg.FormatConditions(1).StopIfTrue = False
  End If
End Sub


' 冻结表格
Sub FreezeTable(rg As Range)
  ActiveWindow.FreezePanes = False
  rg.Select
  ActiveWindow.FreezePanes = True
End Sub


' 锁定单元格
Sub LockTable(rg As Range)
  rg.Locked = True
End Sub


' 解除单元格锁定
Sub UnLockCell(rg As Range)
  rg.Locked = False
End Sub


' 保护工作表
Sub ProtectSheet(ws As Worksheet, passwd As String)
  ws.Protect Password:=passwd, DrawingObjects:=True, Contents:=True, _
             Scenarios:=True, AllowFormattingCells:=True, _
             AllowFormattingColumns:=True, AllowFormattingRows:=True
End Sub


' 解除工作表保护
Sub UnProtectSheet(ws As Worksheet, passwd As String)
  ws.Unprotect Password:=passwd
End Sub


' 选择含有公式的单元格
Function FormulasCells(ws As Worksheet) As Range
  Set FormulasCells = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
End Function