Question

我试图在我的工作表中删除4张图片，它们都遵循一定的命名法：

Sub ABilderLoeschen(OfferteAuftrag As String)
On Error GoTo exitPicLoop1
With ActiveSheet.Pictures
    .ShapeRange("Offerte_1").Delete
    .ShapeRange("Offerte_2").Delete
    .ShapeRange("Offerte_3").Delete
    .ShapeRange("Offerte_4").Delete
    .ShapeRange("Offerte_5").Delete
    .ShapeRange("Offerte_6").Delete
    .ShapeRange("Offerte_7").Delete
    .ShapeRange("Offerte_8").Delete
    .ShapeRange("Offerte_9").Delete
    .ShapeRange("Offerte_10").Delete
exitPicLoop1:
    On Error GoTo exitPicLoop2
    .ShapeRange("Auftrag_1").Delete
    .ShapeRange("Auftrag_2").Delete
    .ShapeRange("Auftrag_3").Delete
    .ShapeRange("Auftrag_4").Delete
    .ShapeRange("Auftrag_5").Delete
    .ShapeRange("Auftrag_6").Delete
    .ShapeRange("Auftrag_7").Delete
    .ShapeRange("Auftrag_8").Delete
    .ShapeRange("Auftrag_9").Delete
    .ShapeRange("Auftrag_10").Delete
End With
exitPicLoop2:

On Error GoTo 0
End Sub

这是一个示例脚本，我在我的实际函数中运行一个循环，但都抛出相同的错误：Runtime Error 7 : Out of Memory

删除第一张照片后总会发生这种情况。之前我通过再次调用该函数删除了前两张图片并且它有效。

有没有办法摆脱错误？

Answer 1

这对你有用吗？

Sub ABilderLoeschen(OfferteAuftrag As String)
For Each pt in ActiveSheet.Pictures
    If Left(pt.Name, 8) = "Offerte_" or Left(pt.Name, 8) = "Auftrag_" Then
        pt.delete
    End If
Next
End Sub

删除多张图片 - 内存不足

1 个答案: