Question

我一直试图找出这个子程序好几天了。我在这个网站上看过关于VBA复制粘贴的每一篇文章，但尚未找到答案。这个概念非常简单，但是当我从命令按钮运行它时，它会在复制工作簿打开后停止，副本不会执行。当我在调试中单步执行时，它按预期工作。有没有人看到任何明显的错误？

'Must have reference to "Microsoft Scripting Runtime" checked
Dim fso As New FileSystemObject 
Dim wsData as Worksheet
Dim stPDFName As String
Dim stFileName As String
Dim stReport As String
Dim WSCopy As Worksheet
Dim FD As Office.FileDialog
Set wsData = ThisWorkbook.Sheets("Sheet1")
Set FD = Application.FileDialog(msoFileDialogFilePicker)
        FD.InitialFileName = "J:\Laboratory\Reports\2015" 
        FD.Show
        stReport = FD.SelectedItems(1)
        stFileName = fso.GetFileName(stReport)
        stPDFName = Left$(stReport, InStrRev(stReport, ".") - 1) & ".pdf"
    If Dir(stPDFName) = "" Then
        MsgBox "Matching PDF version of this report does not exist":
        Exit Sub
    Else
        Workbooks.Open (stReport)
        For Each WSCopy In Workbooks(stFileName).Worksheets
        If StrComp(WSCopy.CodeName, "Sheet1", vbTextCompare) = 0 Then
            WSCopy.Range("A1", "BZ5000").Copy
            wsData.Range("E2").PasteSpecial
            wsData.Columns.AutoFit
            Workbooks(stFileName).Close
            Exit For

        End If
    Next WSCopy
    End If

编辑：我相信我已将问题缩小到了界限： If StrComp(WSCopy.CodeName, "Sheet1", vbTextCompare) = 0 Then 当我逐步完成例程时，StrComp会正确评估。如果我注释掉If/End If行，则例程按预期工作。我使用此行来避免有人移动或重命名工作表时出现的问题。

Answer 1

如果我的怀疑是正确的并且宏已经超前，那么这应该减慢它以便正确执行。我最好的猜测是，不允许设置stReport中的值的时间，所以我在那里放了一个循环，但你可能需要尝试移动它。你可以通过设置一堆断点来测试看看宏离开自身的位置，看看哪些断点允许你在停止后成功恢复脚本的其余部分，以及哪些断开。

我自己DoEvents相当新，我知道如果使用不当可能会占用大量CPU资源，因此请在测试之前保存您的工作，以防您需要强行关闭。

'Must have reference to "Microsoft Scripting Runtime" checked
Dim fso As New FileSystemObject 
Dim wsData as Worksheet
Dim stPDFName As String
Dim stFileName As String
Dim stReport As String
Dim WSCopy As Worksheet
Dim FD As Office.FileDialog
Set wsData = ThisWorkbook.Sheets("Sheet1")
Set FD = Application.FileDialog(msoFileDialogFilePicker)
    FD.InitialFileName = "J:\Laboratory\Reports\2015" 
    FD.Show

        Do Until Not(IsEmpty(stReport))
            stReport = FD.SelectedItems(1)
            DoEvents
        Loop

    stFileName = fso.GetFileName(stReport)
    stPDFName = Left$(stReport, InStrRev(stReport, ".") - 1) & ".pdf"
If Dir(stPDFName) = "" Then
    MsgBox "Matching PDF version of this report does not exist":
    Exit Sub
Else
    Workbooks.Open (stReport)
    For Each WSCopy In Workbooks(stFileName).Worksheets
    If StrComp(WSCopy.CodeName, "Sheet1", vbTextCompare) = 0 Then
        WSCopy.Range("A1", "BZ5000").Copy
        wsData.Range("E2").PasteSpecial
        wsData.Columns.AutoFit
        Workbooks(stFileName).Close
        Exit For

    End If
Next WSCopy
End If

从工作簿到工作簿的VBA复制粘贴令人沮丧

1 个答案: