求大神帮忙，根据前面姓名列提取签名图

yjihau009

怎么按前面姓名列，把签名图提取出来。

3190496160

Sub 删除图片()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
    If shp.TopLeftCell.Row > 7 Then shp.Delete
Next shp
End Sub
Sub 签名图片()
Application.ScreenUpdating = False
Call 删除图片
lj = ThisWorkbook.Path & "\签名图\"
With ActiveSheet
    For j = 2 To 10 Step 4
        r = .Cells(Rows.Count, j).End(xlUp).Row
        If r > 7 Then
            For i = 7 To r
                If .Cells(i, j) <> "" Then
                    f = Dir(lj & .Cells(i, j) & ".png")
                    If f <> "" Then
                        fs = lj & f
                        .Cells(i, j + 1).Select
                        .Pictures.Insert(fs).Select
                        Selection.Placement = xlMoveAndSize
                        With Selection.ShapeRange
                          Selection.ShapeRange.LockAspectRatio = msoFalse
                             .Top = Cells(i, j + 1).Top + 1
                             .Left = Cells(i, j + 1).Left + 1
                             .Width = Cells(i, j + 1).Width
                             .Height = Cells(i, j + 1).Height
                         End With
                    End If
                End If
            Next i
        End If
    Next j
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

Desktop.rar (55.42 KB, 下载次数: 9)

2024-3-22 16:33 上传

点击文件名下载附件

yjihau009

3190496160 发表于 2024-3-22 16:33

谢谢大神