Question

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

这是为什么？我该如何阻止它？我试过设置all the time无济于事。

ScreenUpdating = False

Answer 1

使用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

我还对原始代码进行了一些重构

Answer 2

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

如何解决您的问题：使用Worksheets对象的Microsoft Spec方法将工作簿中的所有工作表复制到新工作表中（最初仅用于格式为公式不起作用）。然后，您需要使用.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 个答案: