我录制了以下两个宏进行薪水条制作,但是在加载过程出现错误提示(以下红色粗体字部分),请高手帮忙修正!!!
Sub Chapter13()
Strsheetname1 = ActiveSheet.Name '获取当前表的名字
Ilen = Len(Strsheetname1) '获取当前表的长度
Sheets.Add after:=Sheets(Strsheetname1) '新加一个表,放在薪水表的后面
'将薪水表的名字中的表换为条做为新表的名字
Strsheetname2 = Left(Strsheetname1, Ilen - 1) + "条"
ActiveSheet.Name = Strsheetname2
Chapter13_1 '调用函数Chapter13_1
End Sub
Sub Chapter13_1()
'定义Irow 取得行数,Icol 取得列数
Dim i As Integer, Irow As Integer, Icol As Integer
'取得行数
Irow = Sheets(Strsheetname1[A1].CurrentRegion.Rows.Count
'取得列数
Icol = Sheets(Strsheetname1[A1].CurrentRegion.Columns.Count
'将Strsheetname1 表内内容复制
Range(Cells(1, 1), Cells(Irow, Icol)Copy
Sheets(Strsheetname2Select '选择表Strsheetname2
ActiveSheet.Paste '粘贴内容
Range("A1"Select '选择性粘贴列宽
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
For i = 2 To Irow - 2
Cells(i * 2, 1Select '从第三行开始插入空行行
Selection.EntireRow.Insert '第隔一行插入
Next i
Range(Cells(2, 1), Cells(2, Icol)Copy '复制表头
For i = 2 To Irow - 2
Cells(i * 2, 1Select '选择空行
ActiveSheet.Paste '给空行粘上表头
Next i
Application.CutCopyMode = False '取消当前Clipboard 上的内容
End Sub |