Visio VBA 代码，用于将 Excel 工作表复制并粘贴到另一个

Question

我有 Visio Vba 宏，它应该从全局变量中获取 Excel 工作表的文件路径。然后它打开该文件，生成一个新的 Excel 工作表，并从旧路径中获取工作表并将其复制到生成的文件中。我的问题是复印纸张。我给它的第一个文件有时可以工作，但是当我再次运行另一个或同一文件时，当它运行此特定行时：

PriceWs.Copy After:=excelWorkbook.Sheets("Sheet1") 

我收到运行时 1004 错误：不支持此类接口，我不明白为什么它一直这样做。

如果有帮助，我会通过仅保存文件路径的全局字符串接收文件路径。示例值：

C:\Users\things\Documents\TESTING.xlsx

我通过用户窗体上的命令按钮运行此代码，该按钮仅运行此宏，仅运行此宏。

此外，在调试时，PriceWs 类型是工作表/工作表（如果这很重要），但代码有时会在这种类型下运行。

Sub CombineExcel()
    
    Dim PriceWb As Workbook
    Dim PriceWs As Worksheet
    Dim PriceString As String
 
    'Error checking for a good file
    'Global is a global string that holds the path to an excel file
    PriceString = GlobalPriceList
    
    Debug.Print "Price String: " & PriceString
    
    On Error Resume Next
     Set PriceWb = Workbooks.Open(PriceString)
    On Error GoTo 0

    If PriceWb Is Nothing Then
        MsgBox "Error: The file is not a valid Excel file or it could not be opened.", vbCritical
        Exit Sub
    End If

      ' Initialize Excel
    Set excelApp = CreateObject("Excel.Application")
    Dim excelWorkbook As Object
    Dim excelWorksheet As Object
    
    Set excelApp = New Excel.Application
    excelApp.Visible = True ' Optional, set to True if you want Excel to be visible
    Set excelWorkbook = excelApp.Workbooks.Add
    Set excelWorksheet = excelWorkbook.Sheets(1)
    
    ' Loop through each sheet in the source workbook
    For Each PriceWs In PriceWb.Sheets
        On Error Resume Next
        PriceWs.Copy After:=excelWorkbook.Sheets(excelWorkbook.Sheets.count)
        If Err.Number <> 0 Then
            Debug.Print "Type Name is: " & TypeName(PriceWs)
            MsgBox "Error copying sheet '" & PriceWs.Name & "': " & Err.Description, vbCritical
        End If
        On Error GoTo 0
    Next PriceWs
    
    Debug.Print GlobalPriceList
    
     ' Delete the Sheet1 without prompting for confirmation
    'Application.DisplayAlerts = False ' Suppress the alert asking for confirmation
    'excelWorkbook.Sheets("Sheet1").Delete
    'Application.DisplayAlerts = True ' Restore the display alerts setting
      
    ' Release object references
    Set excelWorksheet = Nothing
    Set excelWorkbook = Nothing
    Set excelApp = Nothing
    Set PriceWs = Nothing
     
End Sub

Answer 1

请检查方法描述Worksheet.Copy

将工作表复制到当前工作簿或新工作簿中的其他位置。