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 WorkbookSet wb = NewWorkbook(".\" & name)' 只保留一个工作表Dim ws As WorksheetSet 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"             ' 平均利润，总利润除以合伙人数量，这里除以 2Range("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 12ws.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 WorkbookSet wb = NewWorkbook(".\" & name)' 只保留一个工作表Dim ws As WorksheetSet 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 12ws.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 WorkbookSet wb = NewWorkbook(name)' 只保留一个工作表Dim ws As WorksheetSet 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 12ws.Copy After:=ws                          ' 拷贝当前工作表到其之后的位置Set ws = wb.ActiveSheet                    ' 设置新工作表为当前工作表ws.name = i & "月"                         ' 修改工作表标签名Next' 创建参数表wb.Sheets.Add After:=wsSet ws = wb.ActiveSheetws.name = "参数"' 设置参数表的所有单元格格式With ws.Cells.RowHeight = 30                            ' 设置行高.Font.Size = 12                            ' 设置字体.HorizontalAlignment = xlCenter            ' 水平居中.VerticalAlignment = xlCenter              ' 竖直居中.WrapText = True                           ' 自动换行End With' 设置参数表的列宽ws.Range("A1").ColumnWidth = 12ws.Range("B1").ColumnWidth = 36' 设置参数表内容ws.Range("A1:B1").Mergews.Range("A1") = "工作表参数"ws.Range("A2") = "表格标题"ws.Range("B2") = "某某商品进货单"ws.Range("B2").Locked = False' 设置字体ws.Range("A1").Font.Size = 18ws.Range("A1").Font.Bold = Truews.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 12Sheets(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 WorkbookSet wb = NewWorkbook(name)' 只保留一个工作表Dim ws As WorksheetSet 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 StringfieldList() = Split(fields)Dim widthList() As StringwidthList() = Split(widths)' 获取字段数Dim cols As Integercols = UBound(fieldList) - LBound(fieldList) + 1' 合并单元格（标题）Dim rg As RangeSet 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 WithNext' 绘制网格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 WorkbookSet NewWorkbook = Workbooks.Add              ' 创建工作簿Application.DisplayAlerts = False            ' 禁用文件覆盖警告NewWorkbook.SaveAs Filename:=name            ' 保存文件Application.DisplayAlerts = True             ' 恢复文件覆盖警告
End Function' 打开工作薄，并通过函数返回
Function OpenWorkbook(name As String) As WorkbookSet 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 WorksheetApplication.DisplayAlerts = False            ' 禁用删除确认For i = wb.Worksheets.Count To 2 Step -1     ' 循环删除工作表wb.Worksheets(i).DeleteNextApplication.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 WithWith rg.Borders(xlEdgeLeft)                  ' 整体左.LineStyle = xlContinuous.ColorIndex = 0.TintAndShade = 0.Weight = outerWeightEnd WithWith rg.Borders(xlEdgeTop)                   ' 整体左.LineStyle = xlContinuous.ColorIndex = 0.TintAndShade = 0.Weight = outerWeightEnd WithWith rg.Borders(xlEdgeBottom)                ' 整体左.LineStyle = xlContinuous.ColorIndex = 0.TintAndShade = 0.Weight = outerWeightEnd WithWith rg.Borders(xlEdgeRight)                 ' 整体左.LineStyle = xlContinuous.ColorIndex = 0.TintAndShade = 0.Weight = outerWeightEnd 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 Thenrg.HorizontalAlignment = xlCenter         ' 水平居左Elserg.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.DeleteIf redFG Then' 设置条件格式（<0 红色字体）rg.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=0"rg.FormatConditions(rg.FormatConditions.Count).SetFirstPriorityWith rg.FormatConditions(1).Font.color = 255.TintAndShade = 0End Withrg.FormatConditions(1).StopIfTrue = FalseEnd IfIf redBG Then' 设置条件格式（<0 红色背景）rg.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=0"rg.FormatConditions(rg.FormatConditions.Count).SetFirstPriorityWith rg.FormatConditions(1).Interior.PatternColorIndex = xlAutomatic.color = 255.TintAndShade = 0End Withrg.FormatConditions(1).StopIfTrue = FalseEnd IfIf noColor Then' 设置条件格式（=0 文本与背景同色）rg.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=0"rg.FormatConditions(rg.FormatConditions.Count).SetFirstPriorityWith rg.FormatConditions(1).Font.ThemeColor = xlThemeColorDark1.TintAndShade = -4.99893185216834E-02End Withrg.FormatConditions(1).StopIfTrue = FalseEnd If
End Sub' 冻结表格
Sub FreezeTable(rg As Range)ActiveWindow.FreezePanes = Falserg.SelectActiveWindow.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 RangeSet FormulasCells = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
End Function

Excel VBA 宏自动创建表格相关推荐

Excel VBA开发自动发送邮件
一..设置Outlook邮箱帐(略不是本文章的重点) 二..设置Outlook信任中心如下步骤若没有做如下操作设置,则Excel VBA调用Outlook自动发送邮件时提示如下 2.1 Outloo ...
Excel VBA + GUI Script 创建SAP采购订单-ME21N
之前使用VBA写过几个GUI Script,这个是用来使用T-Code ME21N自动创建采购订单,这个脚本的难点在于获取SAP GUI的PO的Item的表格名,多次运行获得的表格名称可能会不一致,因 ...
Excel VBA 高级编程-跨表格多条件筛选
大家好,我是陈小虾,是一名自动化方向的IT民工.写博客是为了记录自己的学习过程,通过不断输出倒逼自己加速成长.但由于水平有限,博客中难免会出现一些BUG,或者有更优方案恳请各位大佬不吝赐教!微信公众号 ...
vb microsoft.xmlhttp 获取所有超链接_利用VBA批量自动生成表格超链接
Excel如何自动生成有超链接的Sheet目录? 如下图中所示的工作簿中,有很多个Sheet.目的是把所有的Sheet在目录表中制作成超链接的形式,点击跳转. 解决方案:录制宏+循环下面的东西可能很 ...
【JPA/ddl-auto】关于JPA下hibernate通过设置ddl-auto完成数据库自动创建表格
最近萌新日常搬砖中,需要创建一个表格.作为一个小白,自然是老老实实地跑去用数据库连接软件建表了,这个被老鸟看到了免不了被diss了一波.然后我就顺便请教了一波关于通过配置jpa下hibernate的d ...
excel利用宏自动复制来自其他excel文件的数据
'这个宏的作用是:把当前文件夹下每一个excel文件的每一行(共8行)复制到总表的每一个sheet工作表中去,即把一个文件里的那1张表的8行复制转换成另一个文件的8张表里的8行,主要用于汇总工作 Pu ...
【一步一步学习VBA】WORD 创建表格并合并表格
vba代码向word文档中插入表格并合并单元格,代码如下: Sub mergeCell() Dim Tbl As Table Set Tbl = ActiveDocument.Tables.Add(A ...
pywin32\win32com 运行 Word、Excel VBA宏最简单的方法
简单粗暴:doc.Application.Run('批处理VBA') 高手应该看懂了,看不懂的,看下面代码: from win32com.client import Dispatch# 打开Word软 ...
jacob调用Excel VBA宏
1,下载jacob https://github.com/freemansoft/jacob-project 下载最新版即可 2,本地配置下载完成后,会得到这几个文件 jacob.jar可引入工程供 ...

Excel VBA 宏自动创建表格

Excel VBA 宏 - 自动创建表格

Excel VBA 宏自动创建表格相关推荐

最新文章

热门文章