Question

我在工作簿中创建了一个userform。打开工作簿时，这是运行的代码：

Private Sub Workbook_Open()
Application.Visible = False
UserForm1.Show
End Sub

所以现在用户只看到Userform。 UserForm上有一个按钮，用于在不可见的运行工作簿中创建工作表，以及我的主要目标：

（1）打开Excel的新实例

（2）将Excel的新实例设置为可见（Application.Visible = True）

（3）将工作表从不可见实例移动到新创建的可见实例。

这是我试过的代码没有成功：

Sub Move()

' Check if there is a sheet named "Data Sheet"
For Each s In ThisWorkbook.Sheets
If Not s.Name <> "Data Sheet" Then

' if true then create new excel instance
    Dim oXLApp As Object, wb As Object
    Dim ws As Worksheet
    Set oXLApp = CreateObject("Excel.Application")
    oXLApp.Visible = True
    Set wb = oXLApp.Workbooks.Add

'move the sheet "Data Sheet" to new workbook
    s.Move Before:=wb.Sheets(1)

'delete all sheets in new workbook except "Data Sheet"
        Application.DisplayAlerts = False
        With wb
        For Each ws In Worksheets
        If ws.Name <> "Data Sheet" Then ws.Delete
        Next
        End With
        Application.DisplayAlerts = True
End If
Next s

End Sub

我设法使用以下代码将工作表移动到新工作簿但在同一个不可见的excel实例中：

Sub Move2()

Dim newWb As Workbook
Dim ws As Worksheet

For Each s In ThisWorkbook.Sheets
    If Not s.Name <> "To Do" Then

        Dim sheetName As String
        sheetName = s.Name

        Set newWb = Workbooks.Add
        s.Move Before:=newWb.Sheets(1)

        Application.DisplayAlerts = False
        With newWb
        For Each ws In Worksheets
        If ws.Name <> "To Do" Then ws.Delete
        Next
        End With
        Application.DisplayAlerts = True

    End If
Next s

End Sub

我的错误是什么？什么是好的解决方法？

Answer 1

如上面的评论中所述，您无法将工作表移动到其他Excel实例。这是一个解决方法。

我们将使用.SaveCopyAs方法保存现有工作簿的副本。您可以详细了解.SaveCopyAs HERE

<强>逻辑

使用.SaveCopyAs在用户的临时目录中保存现有工作簿的副本。
在新的Excel实例中打开副本并删除不需要的工作表。
＆lt; 可选步骤＆gt;将文件（如果需要）重新保存在新位置.xlsx以删除所有宏。

代码（经过审查和测试）

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Dim TempFile As String

Sub MoveSheet()
    Dim oXLApp As Object, wb As Object, ws As Object

    TempFile = TempPath & "MyFile.xlsm"

    On Error Resume Next
    Kill TempFile
    On Error GoTo 0

    ThisWorkbook.SaveCopyAs TempFile

    Set oXLApp = CreateObject("Excel.Application")

    Set wb = oXLApp.Workbooks.Open(TempFile)

    oXLApp.DisplayAlerts = False
    For Each ws In wb.Worksheets
        If ws.Name <> "Data Sheet" Then ws.Delete
    Next

    '~~> Optional step to re save the file as xlsx
    wb.SaveAs "C:\MyNewFile.xlsx", 51

    oXLApp.DisplayAlerts = True

    oXLApp.Visible = True
End Sub

'~~> Function to get the user's temp directory
Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

将工作表移动到可见的Excel实例

1 个答案: