Question

所以我的代码当前如下所示：

用户点击插入按钮
按钮启动文件浏览器
用户选择文件（图像）
代码将变量（文件名）分配给文件路径
然后在最后一个空行上插入矩形
将图像填充设置为用户通过文件路径选择的图像

除以下内容外，没有任何问题。（我说的是图像，实际上是带有图像填充的矩形）

当该列中没有图像，并且用户第一次单击该按钮时，它将图像插入到正确的单元格中（第一个为空）。但是，当用户选择第二张图像时，会将其放置在与第一张图像相同的单元格中。

我已经计算出它不能识别出单元格中的形状/图像包含值。

如果我在第一个单元格中输入了一些文本，然后单击“插入”按钮，它将按需要将图像放入下面的单元格中。

是否有一种方法可以确保单元格识别出形状在其中，则该单元格就有价值，并且代码可以在其中查找下一个单元格。

Dim LastRow As Long
LastRow_num = Cells(Rows.Count, 3).End(xlUp).Row
LastRow_num = LastRow_num + 1
EmptyRow = "C" & LastRow_num

Dim filename As String
filename = Application.GetOpenFilename

Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double

Dim cl As Range
Dim shpRec As Shape

Set cl = Range(EmptyRow)

clLeft = cl.Left
clTop = cl.Top
clHeight = cl.Height
clWidth = cl.Width

Set shpRec = ActiveSheet.Shapes.AddShape(msoShapeRectangle, clLeft, clTop, 370, 240)


    With shpRec.Fill
        .Visible = msoTrue
        .UserPicture (filename)
        .TextureTile = msoFalse
    End With

（LastRow_num为+1的原因是因为代码找到了具有最后一个值的行，而我需要它指向最后一个EMPTY行）

任何帮助将不胜感激！

Answer 1

您已经计算出，“它无法识别出单元格中包含[a]值的形状/图像。”换句话说，在这里无法使用.End(xlUp)；您可以使用Shape.BottomRightCell，然后需要遍历工作表中的形状。

这是一个应该起作用的辅助功能。请注意，如果在图像之间散布了文本或其他值，则此方法可能不起作用，但在这种情况下可以修改。

Function NextEmptyRowForShapes(ByVal ws As Worksheet, ByVal col As Long) As Long
    Dim lastRow As Long

    With ws
        Dim s As Shape
        For Each s In .Shapes
            If Not Intersect(s.BottomRightCell, .Columns(col)) Is Nothing Then
                If s.BottomRightCell.Row > lastRow Then
                    lastRow = s.BottomRightCell.Row
                End If
            End If
        Next s
    End With

    NextEmptyRowForShapes = lastRow + 1
End Function

像这样使用：

LastRow_num = NextEmptyRowForShapes(ActiveSheet, 3)

编辑：

此版本应同时处理形状和文本/值。

Function NextEmptyRowForShapes(ByVal ws As Worksheet, ByVal col As Long) As Long
    With ws
        Dim lastRow As Long
        If Not IsEmpty(.Cells(.Rows.Count, col).End(xlUp)) Then
            lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
        End If

        Dim s As Shape
        For Each s In .Shapes
            If Not Intersect(s.BottomRightCell, .Columns(col)) Is Nothing Then
                If s.BottomRightCell.Row > lastRow Then
                    lastRow = s.BottomRightCell.Row
                End If
            End If
        Next s
    End With

    NextEmptyRowForShapes = lastRow + 1
End Function

找到空的最后一行，插入图片（代码无法识别带有图片的单元格）

1 个答案: