Excel VBA 如果单元格内有图像，则复制上面的单元格

Question

我有这个 A 列，并且在第 1 行和第 4 行有这两个图像： 这是之前

我想要一个循环遍历 A 列，如果单元格为空，则复制上面的单元格及其中的图像（图像被锁定在单元格内并随之移动/调整大小/过滤， 像这样

这应该是最终的结果

谢谢大家。

尝试过这种方法处理非图像，效果很好（更简单）

Sub IfEmpty_CopyAboveCell()

Dim i As Integer
Dim LastRow As Integer

LastRow = Cells(Rows.Count, "A").End(xlUp).Row


For i = ActiveCell.Row To LastRow

    Cells(i, ActiveCell.Column).Select

    If Cells(i, ActiveCell.Column) = "" Then
        Cells(i, ActiveCell.Column) = Cells(i - 1, ActiveCell.Column)
    End If

Next i

End Sub

当涉及到图像时，它会变得更加棘手（尚未起作用）：

Sub IfEmptyImages_CopyAboveCell()

Dim i As Integer
Dim LastRow As Integer
Application.CopyObjectsWithCells = True

LastRow = Cells(Rows.Count, "A").End(xlUp).Row


For i = ActiveCell.Row To LastRow

    Cells(i, ActiveCell.Column).Select

    If CellImageCheck(Cells(i, ActiveCell.Column)) = 0 Then
        Cells(i - 1, ActiveCell.Column).Copy
        Selection.offset(1, 0).Paste
        Cells(i, ActiveCell.Column).Paste
        'Cells(i, ActiveCell.Column) = Cells(i - 1, ActiveCell.Column)
    End If

Next i

End Sub

Function CellImageCheck(CellToCheck As Range) As Integer
    ' Return 1 if image exists in cell, 0 if not
    Dim wShape As shape
    For Each wShape In ActiveSheet.Shapes
        If wShape.TopLeftCell = CellToCheck Then
            CellImageCheck = 1
        Else
            CellImageCheck = 0
        End If
    Next wShape
End Function