批量复制粘贴到指定单元格

liulang0808

ba3259878266 发表于 2024-4-28 15:34
师傅 太难了  能否帮忙写一下  急用

Sub addpicture()

    Application.ScreenUpdating = False
    str1 = "D:\图片\AAA.png"
    For Each Rng In [b2:b15]
        
        ActiveSheet.Pictures.Insert(str1).Select
        With Selection
            .ShapeRange.LockAspectRatio = msoFalse
            .Left = Rng.Left + 1
            .Top = Rng.Top + 1
            .Width = Rng.Offset(0, 1).Left - Rng.Left - 2
            w = Rng.Offset(1, 0).Top
            y = Rng.Top
            .Height = w - y - 2
        End With
    Next Rng
    Application.ScreenUpdating = True
End Sub
代码未测试

liulang0808

代码未测试，供参考
着急的话，可以手动添加图片的
不知道楼主是着急什么的

ba3259878266

liulang0808 发表于 2024-4-28 15:53
Sub addpicture()

    Application.ScreenUpdating = False

师傅 能说说 位置的代码吗  我只是想学习学习应用 不了解内涵  比如  需要复制改到  D列  D5:D9 区域 怎样改 谢谢
还有 每次复制粘贴前要清理上次复制粘贴的内容 麻烦你了

liulang0808

ba3259878266 发表于 2024-4-28 16:39
师傅 能说说 位置的代码吗  我只是想学习学习应用 不了解内涵  比如  需要复制改到  D列  D5:D9 区域 怎 ...

[b2:b15] 对应表格区域
删除图片部分，具体见链接里的案例
都不复杂，楼主上点心思看一下就知道了

ba3259878266

liulang0808 发表于 2024-4-28 18:57
对应表格区域
删除图片部分，具体见链接里的案例
都不复杂，楼主上点心思看一下就知道了

谢谢师傅  弄好了 非常感谢你的耐心教导  非常感谢