没有合适的资源?快使用搜索试试~ 我知道了~
EXcelVBA另存之后删除按钮及宏代码
3星 · 超过75%的资源 需积分: 44 37 下载量 134 浏览量
2017-08-09
11:17:20
上传
评论
收藏 2KB TXT 举报
温馨提示
试读
2页
EXcelVBA另存之后删除按钮及宏代码
资源推荐
资源详情
资源评论
Sub S_生成上报表()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
this_wb_name = ThisWorkbook.Name
bm = "备份"
p_ath = ThisWorkbook.Path & "\": f_name = "绩效统计报表_" & bm & ".xls"
Workbooks.Add
On Error Resume Next
ActiveWorkbook.SaveAs FileName:=p_ath & f_name
On Error GoTo 0
new_wb_name = f_name
With Workbooks(this_wb_name)
Dim shet As String, i As Integer
Application.DisplayAlerts = False
For Each sht In .Sheets
sht.Copy after:=Workbooks(new_wb_name).Sheets(3)
Next sht
End With
Windows(new_wb_name).Activate
For Each sht In Workbooks(this_wb_name).Sheets: sht.Visible = xlSheetVisible: Next
Workbooks(Workbooks.Count).Worksheets("Sheet3").Delete
Workbooks(Workbooks.Count).Worksheets("Sheet2").Delete
Workbooks(Workbooks.Count).Worksheets("Sheet1").Delete
With Workbooks(Workbooks.Count) '以下开始删除VBA代码
Dim vbcCom, Vbc
Set vbcCom = .VBProject.VBComponents
For Each Vbc In vbcCom
If Vbc.Name Like "Sheet*" Or Vbc.Name Like "This*" Then
Vbc.CodeModule.DeleteLines 1, Vbc.CodeModule.CountOfLines
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
this_wb_name = ThisWorkbook.Name
bm = "备份"
p_ath = ThisWorkbook.Path & "\": f_name = "绩效统计报表_" & bm & ".xls"
Workbooks.Add
On Error Resume Next
ActiveWorkbook.SaveAs FileName:=p_ath & f_name
On Error GoTo 0
new_wb_name = f_name
With Workbooks(this_wb_name)
Dim shet As String, i As Integer
Application.DisplayAlerts = False
For Each sht In .Sheets
sht.Copy after:=Workbooks(new_wb_name).Sheets(3)
Next sht
End With
Windows(new_wb_name).Activate
For Each sht In Workbooks(this_wb_name).Sheets: sht.Visible = xlSheetVisible: Next
Workbooks(Workbooks.Count).Worksheets("Sheet3").Delete
Workbooks(Workbooks.Count).Worksheets("Sheet2").Delete
Workbooks(Workbooks.Count).Worksheets("Sheet1").Delete
With Workbooks(Workbooks.Count) '以下开始删除VBA代码
Dim vbcCom, Vbc
Set vbcCom = .VBProject.VBComponents
For Each Vbc In vbcCom
If Vbc.Name Like "Sheet*" Or Vbc.Name Like "This*" Then
Vbc.CodeModule.DeleteLines 1, Vbc.CodeModule.CountOfLines
资源评论
- weixin_415504012018-09-18还可以能用
qq_39784763
- 粉丝: 1
- 资源: 1
上传资源 快速赚钱
- 我的内容管理 展开
- 我的资源 快来上传第一个资源
- 我的收益 登录查看自己的收益
- 我的积分 登录查看自己的积分
- 我的C币 登录后查看C币余额
- 我的收藏
- 我的下载
- 下载帮助
安全验证
文档复制为VIP权益,开通VIP直接复制
信息提交成功