[已解决]请教老师们给予修改一下语句（备份XLS不保存宏）

knifefox

  Sub 全部保存备份退出()
        Dim vbcCom
        Dim Vbc As Object
        Dim WSH As Object
        Dim strVBS As String
        strVBS = Replace(UCase(ThisWorkbook.FullName), ".XLS", ".vbs")  '
        Set WSH = CreateObject("Wscript.Shell")
        For Each Vbc In Application.ThisWorkbook.VBProject.VBComponents
            Select Case Vbc.Type
            Case 1, 2, 3
                With Application.VBE.ActiveVBProject.VBComponents
                    .Remove .Item(Vbc.Name)
                End With
            Case Else
                Vbc.CodeModule.DeleteLines 1, Vbc.CodeModule.CountOfLines
            End Select
        Next
    ActiveWorkbook.SaveAs "E:\备份\" & Format(Now(), "yyyymmdd") & "日常统计(备份).xls"
    MsgBox "以当天日期命名的文件己保存到：E:\备份\...下, 现全部退出Microsoft Excel,再见!!!"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tf = fso.CreateTextFile(strVBS, True) '创建temp文件VBS文件
    With tf '写入VBS文件内容
        .WriteLine ("Set msexcel=GetObject(,""Excel.Application"")")
        .WriteLine ("msexcel.save")
        .WriteLine ("msexcel.quit")
        .WriteLine ("set fso=createobject(""scripting.filesystemobject"") ")
        .WriteLine ("fso.DeleteFile WScript.ScriptFullName")
        .Close
    End With
    WSH.Run Chr(34) & strVBS & Chr(34), 1, True
End Sub

[此贴子已经被作者于2010-8-22 14:21:33编辑过]

whhy2009

如是这样的话，也确实删除不了。再一次感谢你耐心细致的解答！！！

whhy2009

再请教“knifefox”老师：如果我改变方案为：在有宏的XLS中（不退出），点击“备份”按钮，只备份1份上述到指定目录以时间命名的文件（没有宏），要求不要出现提示要如何修改。谢谢！！！

[此贴子已经被作者于2010-8-22 16:42:50编辑过]

whhy2009

---

还是不能解决问题，且没保存备份文件。

knifefox

QUOTE:

以下是引用whhy2009在2010-8-22 16:41:00的发言：

再请教“knifefox”老师：如果我改变方案为：在有宏的XLS中（不退出），点击“备份”按钮，只备份1份上述到指定目录以时间命名的文件（没有宏），要求不要出现提示要如何修改。谢谢！！！

这个你可是新建一个工作薄，然后把sheet全部拷贝过去啊。
这是个好方法。

ps：我上面的代码不行么？

whhy2009

你上面的语句我运行了下可以，但总是出现现提示框，要没有就更理想了（另还想在备份的工作簿中指定删除一个工作表）不知如何写？谢谢！！！

Sub 全部保存备份退出()
        ActiveWorkbook.Save '对有宏的保存
        Application.DisplayAlerts = False
        Dim vbcCom
        Dim Vbc As Object
        Dim WSH As Object
        Dim strVBS As String
        strVBS = Replace(UCase(ThisWorkbook.FullName), ".XLS", ".vbs")  '
        Set WSH = CreateObject("Wscript.Shell")
        For Each Vbc In Application.ThisWorkbook.VBProject.VBComponents
            Select Case Vbc.Type
            Case 1, 2, 3
                With Application.VBE.ActiveVBProject.VBComponents
                    .Remove .Item(Vbc.Name)
                End With
            Case Else
                Vbc.CodeModule.DeleteLines 1, Vbc.CodeModule.CountOfLines
            End Select
        Next
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tf = fso.CreateTextFile(strVBS, True) '创建temp文件VBS文件
    With tf '写入VBS文件内容
        .WriteLine ("Set msexcel=GetObject(,""Excel.Application"")")
        .WriteLine ("msexcel.save")
        .WriteLine ("msexcel.quit")
        .WriteLine ("set fso=createobject(""scripting.filesystemobject"") ")
        .WriteLine ("fso.DeleteFile WScript.ScriptFullName")
        .Close
    End With
    WSH.Run Chr(34) & strVBS & Chr(34), 1, True
    ActiveWorkbook.SaveAs "E:\备份\" & Format(Now(), "yyyymmdd") & "条件复制(BAk).xls"
     Sheets("操作").Delete '删除指定工作表
      ActiveWorkbook.Save '对备份的保存
    MsgBox "文件己保存到：E:\备份\......下"
End Sub

[此贴子已经被作者于2010-8-22 19:58:43编辑过]

knifefox

Application.DisplayAlerts = False

加个这个

gpggpggpg

遇到同样的问题，打开alerts开关后才能删除vba但是就需要手动干预