excel宏设置之一键生成多张sheet并写入内容与格式

提示：excel先开启宏设置！

（一）效果：

第一张表，有宏按钮

 

结果图：

说明：生成的sheet包括窗口冻结，数据有效性，背景以及字体颜色，单元格宽高，字段名设置等

代码如下：（第一次写，望指点）

单位名称不能为数字

Sub 按钮2_Click()
 
' 批量新建多个sheet表，新建一个cresheet的宏

Dim a As Integer               '定义a变量

Dim strArr As Variant         '定义字符数组

Dim alpArr As Variant         '定义字母数组

Dim length '用length表示数组的长度

a = 5                               '初始值，从第5行开始，可以更改

Set st = Worksheets("纳税企业申报信息表")       ' 表初始值，定位源数据表，可以更改


'while开始根据本表D5列生成sheet
Do While st.Cells(a, "D") <> ""   ' 设定循环条件，从纳税企业申报信息表中的D5开始，如果数据不为空，执行该循环

On Error Resume Next            ' 若表名不存在，忽略代码引起的运行错误



'if每一次循环生成一个新sheet并设置好里面的内容

If Worksheets(st.Cells(a, "D").Value) Is Nothing Then   '判断是否存在对应的工作表

Worksheets.Add after:=Worksheets(Worksheets.Count)      '永远将新表加入到最后一个工作表之后

ActiveSheet.Name = st.Cells(a, "D").Value             '新的工作表为当前活动的工作，将工作表的名称更改为纳税企业申报信息表中对应单元格的名字。


'单元格设置内容并设置水平垂直居中
Range("A1").Value = "企业名称："
Range("A1").HorizontalAlignment = Excel.xlLeft
Range("A1").VerticalAlignment = Excel.xlCenter


Range("B1").Value = st.Cells(a, "D").Value
Range("B1").HorizontalAlignment = Excel.xlLeft
Range("B1").VerticalAlignment = Excel.xlCenter


Range("A2").Value = "纳税人识别号："
Range("A2").HorizontalAlignment = Excel.xlLeft
Range("A2").VerticalAlignment = Excel.xlCenter


Range("B2").Value = st.Cells(a, "E").Value
Range("B2").HorizontalAlignment = Excel.xlLeft
Range("B2").VerticalAlignment = Excel.xlCenter


'单元格设置高
Range("A1").RowHeight = 30

Range("A2").RowHeight = 30

Range("A3").RowHeight = 30

Range("A4").RowHeight = 40


'列名
strArr = Array("序号", "工号", "*姓名", "*证照类型", "*证照号码", "*国籍(地区)", "*性别", "*出生日期", "*人员状态", "*任职受雇从业类型", "手机号码", "任职受雇从业日期", "*本期收入", "本期免税收入", "离职日期", "个人投资额", "个人投资比例(%)", "基本养老保险费", "基本医疗保险费", "失业保险费", "住房公积金", "累计子女教育", "累计继续教育", "累计住房贷款利息", "累计住房租金", "累计赡养老人", "企业(职业)年金", "商业健康保险", "税延养老保险", "其他", "准予扣除的捐赠额", "免税额", "是否残疾", "是否烈属", "是否孤老", "残疾证号", "烈属证号", "是否境外人员", "中文名", "涉税事由", "出生国家(地区)", "首次入境时间", "预计离境时间", "其他证照类型", "其他证照号码", "户籍所在地（省）", "户籍所在地（市）", "户籍所在地（区县）", "户籍所在地（详细地址）", "居住地址（省）", "居住地址（市）", "居住地址（区县）", "居住地址（详细地址）", "联系地址（省）", "联系地址（市）", "联系地址（区县）", "联系地址（详细地址）", "电子邮箱", "学历", "开户银行", "银行账号", "职务", "备注")

alpArr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK")

'列长度
length = UBound(strArr) - LBound(strArr) + 1

'for循环在sheet生成列名
For i = 0 To (length - 1)
   Range(alpArr(i) + "4").Value = strArr(i)
   Range(alpArr(i) + "4").Interior.Color = RGB(204, 204, 255)                   '单元格背景颜色
   Range(alpArr(i) + "4").ColumnWidth = 10                                      '单元格设置宽
   Range(alpArr(i) + "4").HorizontalAlignment = Excel.xlCenter                  '文字水平垂直居中
   Range(alpArr(i) + "4").VerticalAlignment = Excel.xlCenter

   Next

Range(Cells(5, 1), Cells(500, 63)).Borders.LineStyle = xlDash         '单元格边框格式虚线



'下面是冻结窗口
Set wd = ActiveWindow
With wd
.SplitColumn = 13
.SplitRow = 4
End With
ActiveWindow.FreezePanes = True
Set wd = Nothing
'冻结窗口完毕


'设置字体颜色为红色
Range(Cells(4, 3), Cells(4, 13)).Font.Color = RGB(255, 0, 0)

'设置数据有效性


    With [e4:e4].Validation  '证照号码提示
        .Delete
        .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "当证照类型为""居民身份证"",请输入18位居民身份证号"
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    With [c4:c4].Validation  '*姓名提示
        .Delete
        .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "证照类型为外国护照时，录入证件上的英文姓名，其他证件录入中文姓名"
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    With [f4:f4].Validation  '*国籍提示
        .Delete
        .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "证照类型为""居民身份证""时，允许为空"
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    With [g4:g4].Validation  '*性别提示
        .Delete
        .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "证照类型为""居民身份证""时，允许为空"
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    With [h4:h4].Validation  '*出生日期提示
        .Delete
        .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "证照类型为""居民身份证""时，允许为空。请严格按照如下格式填写：2018-12-12"
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    With [k4:k4].Validation  '手机号码提示
        .Delete
        .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "当""任职受雇从业类型""为""雇员""时必须填写。请输入11位手机号码。"
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    With [l4:l4].Validation  '任职受雇从业日期提示
        .Delete
        .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="1"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = "当""任职受雇从业类型""为""雇员""、""保险营销员""和""证券经纪人""时必须填写。请严格按照如下格式填写:2018-12-12"
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    
    With [d5:d65536].Validation  '*证照类型下拉
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="居民身份证,中国护照,港澳居民来往内地通行证,台湾人民来往大陆通行证,外国护照"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    With [f5:f65536].Validation  '*国籍下拉
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="中国,中国澳门,中国香港,中国台湾"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    With [g5:g65536].Validation  '*性别下拉
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="男,女"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    With [i5:i65536].Validation  '*人员状态下拉
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="正常,非正常"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    With [j5:j65536].Validation  '*任职受雇从业类型下拉
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="雇员,保险营销员,证券经纪人,其他"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With

'数据有效性设置完毕



'if结束
End If

a = a + 1   '行号加1，继续新增下一个

'while结束
Loop
MsgBox ("生成个税工资表完毕，请前往填写！")

End Sub