导出当前工作表，不带VBA代码及公式导出

yjwdjfqb

导出当前工作表，不带VBA代码及公式导出

请朋友们帮帮忙，谢谢大家了！

导出当前工作表，不带VBA代码及公式导出.rar (9.65 KB, 下载次数: 23)

2014-3-30 19:58 上传

点击文件名下载附件

cbtaja

1. Sub 导出当前工作表()
   
2.     Dim booksname As String
   
3.     Dim Str As String
   
4.     Str = VBA.Environ("USERPROFILE") & "\桌面"
   
5.     booksname = Str & ActiveSheet.Name
   
6.     On Error Resume Next
   
7.     With Workbooks.Add
   
8.         c = .Sheets.Count
   
9.         ReDim Shts(1 To c) '工作表名称数组
   
10.         For i = 1 To c
    
11.             Shts(i) = .Sheets(i).Name '数组赋值
    
12.         Next
    
13.         ThisWorkbook.ActiveSheet.Copy after:=.Sheets(c) '导出当前工作表
    
14.         .ActiveSheet.DrawingObjects.Delete '删除按钮等所有形状
    
15.         .ActiveSheet.UsedRange = .ActiveSheet.UsedRange.Value '转化为值
    
16.         .Sheets(Shts).Delete '删除新工作薄中的原有工作表
    
17.         
    
18.         '------------------------------------------------
    
19.         '以下循环语句删除工作薄的VBA工程中所有模块中的全部代码，
    
20.         '但提前是需要事先在“宏—安全性—可靠发行商”中勾选“信任对于VB项目的访问”，
    
21.         '否则以下对VB项目访问的语句会被忽略。
    
22.         For Each vbc In .VBProject.VBComponents
    
23.             With vbc.CodeModule
    
24.                 .DeleteLines 1, .CountOfLines
    
25.             End With
    
26.         Next
    
27.         '------------------------------------------------
    
28.         .SaveAs Filename:=booksname '保存
    
29.         .Close
    
30.     End With
    
31. End Sub

复制代码

jhzghua

记录一下    .

ty1014

cbtaja 发表于 2014-3-30 23:33

对象不支持该属性