为啥打开新工作簿时宏停止运行？

Posted 2023-05-07

【中文标题】为啥打开新工作簿时宏停止运行？

【英文标题】：Why does Macro Stop Running When New Workbook Opened?为什么打开新工作簿时宏停止运行？

【发布时间】：2016-11-11 04:11:03

【问题描述】：

我正在使用以下代码 sn-p 来保存电子表格，使其仅值并重新保存。然而，工作簿打开然后宏停止运行。

这是为什么？我该如何阻止它？我试过设置ScreenUpdating = False 无济于事。

Sub saveReport()
    Dim nwkbk As Workbook
    Dim thsWkbk As Workbook

    Set thsWkbk = ThisWorkbook

    nwkbkPath = thsWkbk.Path & "\x. Archive\" & Format(Date, "YYYY-MM-DD - ") & thsWkbk.Name

    ApplicationDisplayAlerts = False
    thsWkbk.SaveCopyAs nwkbkPath

    Set nwkbk = Workbooks.Open(nwkbkPath, False)

    For w = 1 To nwkbk.Sheets.Count
        nwkbk.Sheets(w).UsedRange = nwkbk.Sheets(w).UsedRange.Value
    Next w

    For wsp = 1 To nwkbk.Sheets.Count
        nwkbk.Sheets(wsp).Protect Password:="SettleDownBenny"
    Next wsp

    Application.DisplayAlerts = False
    nwkbk.Save

    nwkbk.Close

End Sub

【问题讨论】：

我认为您的 nwkbkPath = thsWkbk.Path & "\x. Archive\" & Format(Date, "YYYY-MM-DD - ") & thsWkbk.Name 有错误，您是否在此 Excel 文件的当前路径下嵌套了一个文件夹“x.Archive”？

您的原始工作簿中有一些事件处理程序吗？它们将被复制到新工作簿并干扰正在运行的宏：尝试将其保存为纯 xlsx 文件，因此没有宏存活

@user3598756 正确。我有一个 AutoOpen 方法，该方法在电子表格打开后立即运行。好接。如何保存副本，但选择格式？与 VBA 结合使用时，Excel 管理起来非常荒谬。

【参考方案1】：

答案：您的宏停止运行，因为它保存为xlsm。它可能在打开时启动事件处理程序，从而停止原始宏。更新：在这种情况下，Auto_Open 方法会在 xlsm 打开时自动运行。

如何解决您的问题： 使用Worksheets 对象的Copy() 方法将所有工作表从工作簿复制到新工作簿（最初只是为了格式，因为公式不起作用）。然后，您需要使用.Value 属性将这些值单独复制为值，以确保逐字复制所有值。然后调用SaveAs() 方法来保存它。

代码如下：

Sub saveReport()
Dim nwkbkPath As String
Dim w As Long


Set thsWorkbook = ThisWorkbook


With thsWorkbook '<--| reference 'ThisWorkbook'
    nwkbkPath = .Path & "\x. Archive\" & Format(Date, "YYYY-MM-DD - ") & GetName(.Name) '<--| use only the "strict" name (no extension) of ThisWorkbook
    .Sheets.Copy '<--| copy all worksheets from 'thsWkbk' to a new workbook, which also becomes the 'ActiveWorkbook'
End With


On Error GoTo ErrHandler
Application.DisplayAlerts = False

Set nwWorkbook = ActiveWorkbook

For w = 1 To nwWorkbook.Sheets.Count
    nwWorkbook.Sheets(w).UsedRange = thsWorkbook.Sheets(w).UsedRange.Value
Next w


For w = 1 To nwWorkbook.Sheets.Count
    nwWorkbook.Sheets(w).Protect Password:="SettleDownBenny"
Next w
nwWorkbook.SaveAs nwkbkPath


ActiveWorkbook.Close


ErrHandler:
    Application.DisplayAlerts = True
End Sub


Function GetName(wbName As String) As String
    GetName = Left(wbName, InStrRev(wbName, ".") - 1)
End Function

【参考方案2】：

使用Worksheets对象的Copy()方法将所有工作表从工作簿复制到一个新工作簿，在该工作簿上执行所有需要的操作，最后调用SaveAs()方法

如下

Option Explicit

Sub saveReport()
    Dim nwkbkPath As String
    Dim w As Long

    With ThisWorkbook '<--| reference 'ThisWorkbook'
        nwkbkPath = .Path & "\x. Archive\" & Format(Date, "YYYY-MM-DD - ") & GetName(.name) '<--| use only the "strict" name (no extension) of ThisWorkbook
        .Sheets.Copy '<--| copy all worksheets from 'thsWkbk' to a new workbook, which also becomes the 'ActiveWorkbook'
    End With

    On Error GoTo ErrHandler
    Application.DisplayAlerts = False
    With ActiveWorkbook '<--| reference the ActiveWorkbook
        For w = 1 To .Sheets.Count
            .Sheets(w).UsedRange = .Sheets(w).UsedRange.Value
        Next w

        For w = 1 To .Sheets.Count
            .Sheets(w).Protect Password:="SettleDownBenny"
        Next w
        .SaveAs nwkbkPath
    End With
    ActiveWorkbook.Close

ErrHandler:
    Application.DisplayAlerts = True
End Sub

Function GetName(wbName As String) As String
    GetName = Left(wbName, InStrRev(wbName, ".") - 1)
End Function

我还对您的原始代码做了一些小的重构

【讨论】：

我不接受，因为它实际上破坏了很多数据并且没有将其保存为值。 #NAME? 错误在此宏的粘贴值中非常普遍。我会看看我是否可以编辑你的答案，当它复制值时我会重新接受它。

这是因为在复制过程中，我创建的任何自定义函数都会通过保存为xlsx 来删除，从而导致#NAME? 错误。

您的original问题中未指定自定义功能问题，因此无法要求我的回答处理它。根据本网站规则，您应该接受它，因为它解决了原始问题并为新问题发布新问题。

我可以使用有效的代码对其进行编辑，并将答案添加到您上面的评论中实际包含的问题吗？

我还认为，如果我想要一个函数，我希望它在所有情况下都能工作。