另存为工作薄时如何删除新工作薄中的控件

ugyun

各位老师：
        下面这段代码是将原工作薄中的“制单”表单独另存为一个新的工作薄，希望另存后的表中无代码、无控件，但下面的“ActiveSheet.DrawingObjects.Delete ”没起到作用，原表中的listbox和textbox仍保留在新工作薄中（VBA代码删除成功了）

1. 
   
2. Sub daochu()
   
3. Dim BF
   
4.     BF = MsgBox("　　制单导出必须信任“Visual Basic项目”的访问，否则导出数据时可能会提示：“不信任到Visual Basic Project的程序连接”的提示。" & Chr(13) & Chr(13) & "　　解决方法：请先退出系统，再打开一个新的excel，在工具-宏-安全性-“可靠发行商”选项卡下勾选“信任对于‘Visual Basic项目’的访问”即可。" & Chr(13) & Chr(13) & "　　确定要导出所有制单吗？", 289, "系统信息")
   
5.     If BF = 1 Then
   
6.      fileSaveName = Application.GetSaveAsFilename("批量制单导出" & Format(Now, "YYYY-MM-DD-HHmmSS"), filefilter:="Microsoft Office Excel 工作薄 (*.xls), *.xls", Title:="数据导出>>>请选择路径并命名")
   
7.         If fileSaveName <> False Then
   
8.            With Sheets("制单")
   
9.               Sheets("制单").Visible = True
   
10.               Sheets("制单").Activate
    
11.               ActiveSheet.Copy
    
12.            End With
    
13.                   
    
14.                   Set vc = ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule '另存前删除“制单”中的代码
    
15.                   X = vc.CountOfLines
    
16.                   For I = X To 1 Step -1
    
17.                   vc.DeleteLines I
    
18.                   ActiveSheet.DrawingObjects.Delete '另存前删除“制单”中的控件
    
19.                   Next
    
20.                   
    
21.                    ActiveWorkbook.Close SaveChanges:=True, Filename:=fileSaveName
    
22.                    MsgBox "所有制单已成功导出到指定目录下！" & Chr(13) & Chr(13) & "数据文件名为：" & fileSaveName, 64, "批量制单导出"
    
23.                    Sheets("制单").Select
    
24.               Exit Sub
    
25.          Else
    
26.              MsgBox "您未选择导出制单路径，导出中止！", 64, "制单导出"
    
27.          End If
    
28.       Else
    
29.           MsgBox "您已取消了制单导出！", 64, "系统信息"
    
30.       End If
    
31. End Sub

复制代码

ugyun

哪位老师帮忙看看，谢谢了

ugyun

帖子发了几天了，没老师帮忙，现已将附件传上来了，放在1楼了，哪位老师路过帮忙看看，谢谢了

LBTDI

ActiveSheet.DrawingObjects.Delete 这行代码有误，应为ActiveSheet.SHAPES（INDEX）.Delete
用个FOR循环 TO ActiveSheet.SHAPES.COUNT
然后循环 ActiveSheet.SHAPES（INDEX）.Delete 删除即可

ugyun

LBTDI 发表于 2013-6-15 18:35
ActiveSheet.DrawingObjects.Delete 这行代码有误，应为ActiveSheet.SHAPES（INDEX）.Delete
用个FOR循环  ...

好像还是不行哦，请指点

LBTDI

ugyun 发表于 2013-6-15 18:41
好像还是不行哦，请指点

ACTIVESHEET.SHAPES.COUNT返回的是你激活工作表所使用的控件的总数量，要不你循环下
FOR COUNTER = 1 TO  ACTIVESHEET.SHAPES.COUNT
MSGBOX ACTIVESHEET.SHAPES(COUNTER).NAME
ACTIVESHEET.SHAPES(COUNTER).DELETE
NEXT

ugyun

LBTDI 发表于 2013-6-15 18:47
ACTIVESHEET.SHAPES.COUNT返回的是你激活工作表所使用的控件的总数量，要不你循环下
FOR COUNTER = 1 TO ...

经测试，还是不行

浓墨郁金香

ugyun 发表于 2013-6-15 18:54
经测试，还是不行

Sub A()
Do While ActiveSheet.Shapes.Count >= 1

ActiveSheet.Shapes(1).Delete

Loop

End Sub
唉，没办法了，号没等级，限制发帖，随便整个发下，用DO就可以完成，因为FOR的时候，COUNT在减少，COUNTER到后面溢出的，你按这个写就可以

ugyun

浓墨郁金香 发表于 2013-6-15 19:02
Sub A()
Do While ActiveSheet.Shapes.Count >= 1

很好，看了那么多代码，就这一个真正实现了另存时删除新工作薄的控件

livedcn

浓墨郁金香 发表于 2013-6-15 19:02
Sub A()
Do While ActiveSheet.Shapes.Count >= 1

就这个答案，简单明了的解决了我的问题。