一键批量插入图片的2个疑难问题（已解决，方案上传供分享）

kisa_babe

请问附件有吗？试了下还是不能用那个vba代码

kisa_babe

zjdh 发表于 2014-8-25 15:51

你好，我下载了，但是表格不能编辑，请大师赐教

zjdh

kisa_babe 发表于 2015-8-27 12:40
你好，我下载了，但是表格不能编辑，请大师赐教

本主题中有那么多附件，你下载的是哪一个？具体是啥情况

kisa_babe

zjdh 发表于 2015-8-27 14:35
本主题中有那么多附件，你下载的是哪一个？具体是啥情况

就是一键插入的那个附件！

把货号复制到A列，然后一按插入键应该直接跳出货号对应的图片，但是现在我都按照里面的要求做，就是最后按键不跳出图片，不知道是哪里出了问题

lk710618

kisa_babe 发表于 2015-8-28 11:37
就是一键插入的那个附件！

把货号复制到A列，然后一按插入键应该直接跳出货号对应的图片，但是现在我 ...

你重新下载这个看看吧

ww0000

好帖子,做个记号

yanyueqin

分享可选路径代码：
Private Sub CommandButton1_Click()
    On Error Resume Next
    Dim rngTemp As Range, k As Range, shpPic As Picture
    Set rngTemp = Application.InputBox("图片插入区域：", "选择单元格", Type:=8)
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If fd.Show = -1 Then
        FilePath = fd.SelectedItems(1) & "\"
    Else
        Exit Sub
    End If
    For Each k In rngTemp
        With k
            Filename = Dir(FilePath & .Value & "*.jpg")
            If k <> "" And Filename <> "" Then
                ActiveSheet.Shapes.AddPicture FilePath & Filename, False, True, .Left, .Top, .Width, .Height
                .ClearComments
                .AddComment
                .Comment.Shape.Fill.UserPicture FilePath & "\" & .Value & ".jpg"
                .Comment.Shape.Height = 180
                .Comment.Shape.Width = 240
                 Filename = ""
           End If
        End With
    Next
        ActiveSheet.Shapes.SelectAll
        Selection.Placement = xlMoveAndSize
        Range("A1").Select
End Sub

kane027

留个记号         

thzss

从头到尾看了,很有收获,感谢各位达人

lk710618

kisa_babe 发表于 2015-8-28 11:37
就是一键插入的那个附件！

把货号复制到A列，然后一按插入键应该直接跳出货号对应的图片，但是现在我 ...

你的表格信任中心的宏设置有没有启用啊？