VBA快速插入签名(位置不固定)

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

VBA快速插入签名(位置不固定)_第1张图片

签名图片为透明背景的PNG文件(左上角方框内的部分),图片文件属性信息如下图所示。
VBA快速插入签名(位置不固定)_第2张图片

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相同(重复查找)。

你可能感兴趣的:(图片,VBA,工作表,签名,动态位置,插入图片,图片位置,自适应)