各位老师，自动插入图片与合同单元格同大小用VBA如何做，谢谢大家的帮忙了

lnddcy

各位老师，自动插入图片与合同单元格同大小用VBA如何做，我在网上找了一段代码，但是有点问题，哪位老师能帮忙改一下，
我希望达到的功能就是按照B列对应的名称插入，插入的大小与合同单元格一致，再就是避免重复插入，谢谢大家的帮忙了，详见附件

lnddcy

自己顶一下

cqlpjxx

我修改了一下，插入的代码，你试试
Sub test()
Dim r As Long, i As Long
r = [c65536].End(xlUp).Row
For i = 4 To r Step 7
    If Dir(ThisWorkbook.Path & "\" & Cells(i, 2) & ".jpg") <> "" Then
        With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Cells(i, 2) & ".jpg").ShapeRange
            .LockAspectRatio = msoFalse
            .Left = Cells(i, 1).Left
            .Top = Cells(i, 1).Top
            .Height = Cells(i, 1).MergeArea.Height
            .Width = Cells(i, 1).MergeArea.Width
        End With
    End If
Next i
End Sub

cqlpjxx

避免重复插入，常用的方法，就是先删除图片对象，再插入。如果有判断某单元格有图片的方法就好了。

lnddcy

十分感觉你的帮助，我也是刚刚解决，你的办法更好，代码更清晰
现在最最主要的问题是怎么样做，插入一次图片就行，如果点击次数多了，插入的就多了，怎么才能避免出现重复插入的问题，谢谢你了

cqlpjxx

lnddcy 发表于 2015-8-18 18:14
十分感觉你的帮助，我也是刚刚解决，你的办法更好，代码更清晰
现在最最主要的问题是怎么样做，插入一次图 ...

思路：插入图片的同时，在单元格内输入一个数，作记号；第二次运行代码，先检查，没有记号的，才运行插入图片代码。这样，就避免了重复插入。修改代码如下：

Sub test()
Dim r As Integer, i As Integer, iy As Integer
r = [c65536].End(xlUp).Row
For i = 4 To r Step 7
   If Cells(i, 1) = "" Then
    If Dir(ThisWorkbook.Path & "\" & Cells(i, 2) & ".jpg") <> "" Then
        With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Cells(i, 2) & ".jpg").ShapeRange
            .LockAspectRatio = msoFalse
            .Left = Cells(i, 1).Left
            .Top = Cells(i, 1).Top
            .Height = Cells(i, 1).MergeArea.Height
            .Width = Cells(i, 1).MergeArea.Width
        End With
        Cells(i, 1) = i
    End If
    End If
Next i
End Sub

lnddcy

非常感谢你的帮助，实现了我想要的功能，再次谢谢你。