excel - 静默 VBA 添加新的 Excel 工作表而无需屏幕更新

Question

我正在向我的工作簿添加一个新工作表

Application.ScreenUpdating = False
SheetExists = False
For Each WS In Worksheets
    If WS.Name = "BLANK" Then
        SheetExists = True
    End If
Next WS
If Not SheetExists Then
    Sheets.Add
    ActiveSheet.Name = "BLANK"
End If

有没有办法在不将焦点集中到或激活新添加的工作表的情况下静默添加 sheet.add？我只想留在当前处于事件状态的工作表(即 Sheet1)上并在后台添加新工作表。
谢谢

Answer 1

起初，事情看起来很简单，但有几点需要考虑:

在运行代码

之前可能会选择更多工作表

所选工作表可能是图表工作表

可以保护工作簿

您可能不想设置 Application.ScreenUpdating = True在方法结束时，因为您可能在另一个仍然需要它的方法中运行它

只有激活了正确的窗 Eloquent 能恢复选择

你可以使用这个方法:

Sub AddWorksheet(ByVal targetBook As Workbook, ByVal sheetname As String)
    Const methodName As String = "AddWorksheet"
    
    'Do input checks
    If targetBook Is Nothing Then
        Err.Raise 91, methodName, "Target Book not set"
    ElseIf sheetname = vbNullString Then
        Err.Raise 5, methodName, "Sheet name cannot be blank"
    ElseIf Len(sheetname) > 31 Then
        Err.Raise 5, methodName, "Sheet name cannot exceed 31 characters"
    Else
        Dim arrForbiddenChars() As Variant
        Dim forbiddenChar As Variant
        
        arrForbiddenChars = Array(":", "\", "/", "?", "*", "[", "]")
        For Each forbiddenChar In arrForbiddenChars
            If InStr(1, sheetname, forbiddenChar) > 0 Then
                Err.Raise 5, methodName, "Sheet name cannot contain characters: : \ / ? * [ or ]"
            End If
        Next forbiddenChar
    End If

    Dim alreadyExists As Boolean
    
    'Check if a sheet already exists with the desired name
    On Error Resume Next
    alreadyExists = Not (targetBook.Sheets(sheetname) Is Nothing)
    On Error GoTo 0
    If alreadyExists Then
        MsgBox "A sheet named <" & sheetname & "> already exists!", vbInformation, "Cancelled" 'Can remove
        Exit Sub
    End If
    
    'Check if Workbook is protected
    If targetBook.ProtectStructure Then
        'Maybe write code to ask for password and then unprotect
        '
        '
        'Or simply exit
        MsgBox "Workbook is protected. Cannot add sheet", vbInformation, "Cancelled"
        Exit Sub
    End If
    
    Dim bookActiveWindow As Window
    Dim appActiveWindow As Window
    Dim selectedSheets As Sheets
    Dim screenUpdate As Boolean
    Dim newWSheet As Worksheet
    
    'Store state
    Set bookActiveWindow = targetBook.Windows(1)
    Set appActiveWindow = Application.ActiveWindow 'Can be different from the target book window
    Set selectedSheets = bookActiveWindow.selectedSheets
    screenUpdate = Application.ScreenUpdating
    
    'Do main logic
    screenUpdate = False
    If bookActiveWindow.Hwnd <> Application.ActiveWindow.Hwnd Then
        bookActiveWindow.Activate
    End If
    If selectedSheets.Count > 1 Then selectedSheets(1).Select Replace:=True
    Set newWSheet = targetBook.Worksheets.Add
    newWSheet.Name = sheetname
    
    'Restore state
    selectedSheets.Select Replace:=True
    If appActiveWindow.Hwnd <> Application.ActiveWindow.Hwnd Then
        appActiveWindow.Activate
    End If
    Application.ScreenUpdating = screenUpdate
End Sub

如果您想要包含代码的书，那么您可以调用:

Sub Test()
    AddWorksheet ThisWorkbook, "BLANK"
End Sub

或者，如果您想要当前事件的书(假设您从加载项运行它)，那么您可以调用:

Sub Test()
    AddWorksheet ActiveWorkbook, "BLANK"
End Sub

或任何其他书籍，具体取决于您的需要。