求如何导入图片

wzd028

求各位大师，表格指定单元格如何批量导入图片，谢谢！


1、第一、二行是标题行，遍历当前工作表的第三行开始的所有行，从第三行开始处理数据。
2、运行代码时弹出对话框弹出选择图片存放的文件夹，遍历该文件夹下的所有文件。
3、根据当前工作表C列单元格名称，在文件夹中查找图片，单元格名称必须和图片名称匹配一致，图片导入到B列。
4、导入的图片不要是一个外部链接（表格要单独发给别人，以免打开表格不能显示图片），图片填满单元格，大小和位置随单元格改变。

      新建文件夹 (3).rar (1.16 MB, 下载次数: 10)

2024-6-19 22:19 上传

点击文件名下载附件

gwjkkkkk

..............

quqiyuan

参与一下，供参考。。。

quqiyuan

代码如下。。
Sub test()
    maxR = Sheet1.[c1048576].End(3).Row
    If maxR <= 2 Then MsgBox "工作表空!!！": Exit Sub
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\"
        .Title = "选择文件夹："
        If .Show = -1 Then p = .SelectedItems(1) Else MsgBox "没有选择文件夹！退出！": Exit Sub
    End With
    Set Rng = Sheet1.Range("c3:c" & maxR)
    For Each rng1 In Rng
        f = p & "\" & rng1.Value & ".jpg"
        f_exist = Dir(f)
        If f_exist <> "" Then
            For Each shp In Sheet1.Pictures      '先删除原有的图片，否则测试叠了一堆图片
                If Round(shp.Top, 2) = Round(rng1.Offset(, -1).Top, 2) Then
                    shp.Delete
                End If
            Next
            Set shp = Sheet1.Shapes.AddPicture(f, False, True, rng1.Offset(, -1).Left, _
                         rng1.Offset(, -1).Top, rng1.Offset(, -1).Width, rng1.Offset(, -1).Height)
            shp.Placement = xlMoveAndSize       '自适应大小
            shp.LockAspectRatio = msoFalse      '取消锁定纵横比
        Else
            MsgBox f & "不存在！！"
        End If
    Next
    Beep
End Sub

wzd028

gwjkkkkk 发表于 2024-6-19 22:39
..............

你好，表格单独复制到其他地方打开后图片不能显示。


   

wzd028

quqiyuan 发表于 2024-6-19 23:05
参与一下，供参考。。。

谢谢大师的帮助，可以用。

liulang0808

https://club.excelhome.net/threa ... tml?_dsign=15791c27
链接材料可以参考