Excel VBA 图像粘贴问题

Question

我正在创建一个运行求解器的程序，然后将多次运行的结果复制粘贴到摘要页面。由于我之前在这里询问过 Excel 的一些错误，在尝试粘贴时会出现一个循环来检测错误，然后尝试再次粘贴最多 20 次。

在某些情况下，当Excel最终没有发送错误时，图像将粘贴到不正确的工作表上。正如您在下面看到的，我明确告诉它粘贴到“su”，然后明确告诉它要粘贴到“su”中的哪个单元格。有人见过这种行为并且知道如何解决吗？

Sub chartCopy(seq)
Dim ua, udc, wa, wdc, su As Worksheet
Dim wb As Workbook
Dim lastSheet As Integer
Dim Cht As ChartObject
Dim k As Integer
Dim l As Integer
Dim j As Integer
Dim x As Integer
Set wb = ThisWorkbook
Set ua = wb.Worksheets("Unweighted Analysis")
Set udc = wb.Worksheets("Unweighted Data Checks")
Set wa = wb.Worksheets("Weighted Analysis")
Set wdc = wb.Worksheets("Weighted Data Checks")
Set su = wb.Worksheets("Summary Page")

k = 15
l = 1 + (seq - 1) * 11
    
j = 0

If seq <> 4 Then
    lastSheet = 6
Else
    lastSheet = 4
End If
For i = 3 To lastSheet
    For Each Cht In wb.Worksheets(i).ChartObjects
        Debug.Print Cht.Name
        If i = 3 Then
            Cht.Chart.Axes(xlCategory).MinimumScale = ua.Range("DF16").Value
        ElseIf i = 5 Then
            Cht.Chart.Axes(xlCategory).MinimumScale = wa.Range("DG16").Value
        End If
        
        Application.CutCopyMode = False
        Cht.CopyPicture
        
        Do While x < 20
            On Error Resume Next
            su.Paste su.Cells(k, l)
            If Err.Number <> 0 Then
                Debug.Print "Paste failed", x, Err.Number, Err.Description
                DoEvents
                x = x + 1
            Else
                Exit Do
            End If
            On Error GoTo 0
            x = x + 1
        Loop
        k = k + 25
        j = j + 1
    Next Cht
    If i = 4 Then
        k = k + 10
    End If
Next i

Application.DisplayAlerts = True

Call sizeImg

ua.Range("F3:K6").Copy
su.Cells(4, l).PasteSpecial Paste:=xlPasteValues
If seq <> 4 Then
    wa.Range("F3:K6").Copy
    su.Cells(141, l).PasteSpecial Paste:=xlPasteValues
End If

End Sub

Answer 1

一些重构的建议：

Option Explicit

Sub chartCopy(seq)
    Dim ua, udc, wa, wdc, su As Worksheet
    Dim wb As Workbook
    Dim lastSheet As Integer
    Dim Cht As ChartObject
    Dim k As Long, l As Long, i As Long, j As Long, x As Long
    
    Set wb = ThisWorkbook
    Set ua = wb.Worksheets("Unweighted Analysis")
    Set udc = wb.Worksheets("Unweighted Data Checks")
    Set wa = wb.Worksheets("Weighted Analysis")
    Set wdc = wb.Worksheets("Weighted Data Checks")
    Set su = wb.Worksheets("Summary Page")
    
    k = 15
    l = 1 + (seq - 1) * 11
    j = 0
    
    lastSheet = IIf(seq <> 4, 6, 4)
    
    For i = 3 To lastSheet
        For Each Cht In wb.Worksheets(i).ChartObjects
            Debug.Print Cht.Name
            If i = 3 Or i = 5 Then
                Cht.Chart.Axes(xlCategory).MinimumScale = _
                   IIf(i = 3, ua.Range("DF16").Value, wa.Range("DG16").Value)
                DoEvents 'let the chart update...
            End If
            Cht.CopyPicture
            'paste succeeds?
            If Not PastePicRetry(su.Cells(k, l)) Then
                MsgBox "Paste failed for chart '" & Cht.Name & "' on sheet '" & _
                         wb.Worksheets(i).Name & "'", vbExclamation
                'Exit Sub 'exit here?
            End If
            
            k = k + 25 + IIf(i = 4, 10, 0)
            j = j + 1
        Next Cht
    Next i
    
    Application.DisplayAlerts = True
    
    Call sizeImg
    
    CopyValues ua.Range("F3:K6"), su.Cells(4, l)
    If seq <> 4 Then CopyValues wa.Range("F3:K6"), su.Cells(141, l)
    
End Sub

'Copy values from `fromRange` to `toRange`
Sub CopyValues(fromRange As Range, toRange As Range)
    With fromRange
        toRange.Cells(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
    End With
End Sub

'Try to paste in range `rng` - retry up to 20 times
'  Return True if paste succeeds
Function PastePicRetry(rng As Range) As Boolean
    Dim i As Long
    Do While i < 20
        On Error Resume Next
        rng.PasteSpecial
        If Err.Number <> 0 Then
            Debug.Print "Paste failed", i
            DoEvents
        Else
            PastePicRetry = True
            Exit Function
        End If
        On Error GoTo 0
        i = i + 1
    Loop
End Function