如何批量将本工作簿内不同页不同位置不同大小的刘亦菲的照片全部替换为萌娃的图片？

longkui1990

批量替换图片.rar (92.68 KB, 下载次数: 8)

2020-12-3 21:44 上传

点击文件名下载附件

有个大难题想请教下大神
附件中的xlsm中有好几页工作表
在每页工作表的不同位置上有不同大小的刘亦菲的照片（这些图片是由一个jpg粘贴进去，只是人为调整了尺寸和位置）

如何编写VBA语句可以实现自动搜索xlsm中的刘亦菲图片，并且全部删除
然后在每个工作表的B2单元格均粘贴好附件中萌娃的照片，并将萌娃照片设置为长3cm，宽2cm

谢谢



         

liulang0808

Sub addpicture()
    str1 = ThisWorkbook.Path & "\萌娃.jpg"
    Application.ScreenUpdating = False
    For Each sh In Sheets
        sh.Select
        For Each shp In sh.Shapes
            
            If shp.Type = 13 Then
               
                t = shp.Top
                l = shp.Left
                w = shp.Width
                h = shp.Height
                shp.Delete
                ActiveSheet.Pictures.Insert(str1).Select
                With Selection
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Left = l
                    .Top = t
                    .Width = w
                    .Height = h
                End With
            End If
        Next shp
    Next sh

    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考。。。。。。

longkui1990

liulang0808 发表于 2020-12-3 22:11
附件内容供参考。。。。。。

大神好，
目前的这段代码测试了下是相当于把工作表里面的图片在原位置替换为相同大小的萌娃的照片

刚把xlsm更新了下，里面有刘亦菲，有祝绪丹
有没有办法批量删除所有的刘亦菲的图片，保留所有祝绪丹的图片在原位置
然后在每一个工作表的B2单元格黏贴入萌娃照片，并且设置萌娃照片为长3cm，宽2cm

谢谢啦

批量替换图片 2nd.rar (633.15 KB, 下载次数: 8)

2020-12-3 22:39 上传

点击文件名下载附件

liulang0808

longkui1990 发表于 2020-12-3 22:39
大神好，
目前的这段代码测试了下是相当于把工作表里面的图片在原位置替换为相同大小的萌娃的照片

怎么去识别这两人的照片呢？

Jason_WangSS

liulang0808 发表于 2020-12-4 07:02
怎么去识别这两人的照片呢？

长宽比可以试一下

liulang0808

Jason_WangSS 发表于 2020-12-4 08:02
长宽比可以试一下

每张表有几张图片呢？然后怎么去判断呢？
楼主如果有办法，可以参考之前的代码处理下

蓝桥玄霜

图片的例子：

longkui1990

liulang0808 发表于 2020-12-4 07:02
怎么去识别这两人的照片呢？

两张图片在粘贴到xls之前，文件名肯定是不一样的
能有办法通过识别文件名来识别出来么？

longkui1990

liulang0808 发表于 2020-12-4 08:05
每张表有几张图片呢？然后怎么去判断呢？
楼主如果有办法，可以参考之前的代码处理下

实际上是需要将表格中公司的老logo换成新logo
但是内容较多，表格中还有很多其他的图片，也不能一替换就把这些图片给影响了
所以确实需要麻烦大神看看怎么识别出来附件里面的刘亦菲的照片