VBA快速插入签名（位置不固定）

news2025/1/11 17:11:00

实例需求：Excel中的多页表格如下图所示，其中包含多个“受益人签字”，其位置不固定，现在需要在其后插入签名图片。

在这里插入图片描述

签名图片为透明背景的PNG文件（左上角方框内的部分），图片文件属性信息如下图所示。
在这里插入图片描述

Sub Demo()
    Dim objShp, c, pic, firstAddress
    With ActiveSheet
        For Each objShp In .Shapes
            objShp.Delete
        Next
        pic = ThisWorkbook.Path & "\sign.png"
        Set c = .UsedRange.Find("受益人签字", LookIn:=xlValues, LookAt:=xlPart)
        If c Is Nothing Then
            MsgBox "无法定位签名位置"
        Else
            firstAddress = c.Address
            Do
                Debug.Print c.Address
                Set rngAnchor = .Cells(c.Row - 2, c.Column + 7)
                Set objShp = .Pictures.Insert(pic)
                objShp.Top = rngAnchor.Top
                objShp.Left = rngAnchor.Left 
                Set c = .FindNext(c)
            Loop While (Not c Is Nothing) And c.Address <> firstAddress
        End If
    End With
End Sub

【代码解析】
第4~6行代码循环遍历工作表中的Shape对象，第5行代码删除Shape对象。
第7行代码为保存在当前目录中的签名图片的全路径。
第8行代码在当前工作表中查找“受益人签字”，参数LookIn指定在单元格的值，参数LookAt指定查找模式为部分匹配。
第9行代码判断是否查找到符合条件的单元格。
如果没有定位目标单元格，那么第10行代码给出提示信息，否则第12~21行代码循环插入签名图片。
第12行代码记录第一个目标单元格的地址，避免重复处理。
第14行代码输出目标单元格地址，用于核查代码执行过程。
第15行代码获取签名图片的锚点单元格，其位置为目标单元格向上偏移两行，向右偏移6列。
第16行代码在当前工作表中插入签名图片。
第17~18行代码设置图片Top和Left属性，用于调整签名的位置，此处使用锚点单元格的相关属性作为参数值，这比使用绝对数值更方便和准确，签名图片的位置参见插图。
第19行代码查找下一个符合条件的目标单元格。
第20行代码循环结束条件为，无法定位到符合添加的单元格，或者目标单元格地址与firstAddress相同（重复查找）。