输入货号自动带出图片，图片在文档内 怎么使用vba写

简单到爆

比如我输入货号可以自动带出对应的图片
由于附件限制2M  我分割上传了 谢谢大佬指导



输入货号带出图片12.part1.rar (2 MB, 下载次数: 45)

2020-6-29 11:30 上传

点击文件名下载附件

输入货号带出图片12.part2.rar (2 MB, 下载次数: 28)

2020-6-29 11:30 上传

点击文件名下载附件

输入货号带出图片12.part3.rar (337.11 KB, 下载次数: 27)

2020-6-29 11:30 上传

点击文件名下载附件

lwwy1981

关注,学习一下

简单到爆

求大佬 帮忙

深秋的黎明

简单到爆 发表于 2020-6-29 14:15
求大佬 帮忙

可以参考一下这个
做了一个能显示照片的【通讯录】，请大家指教啦
http://club.excelhome.net/thread-1517881-1-1.html
(出处: ExcelHome技术论坛)

深秋的黎明

用引入外部（文件夹）图片的方法。只要把鞋子等商品逐个拍照片，存在一个文件夹里，即可做到。

xuemei0216

看一下，是不是你想要的。
但是要注意，图片1里面的图片四个角都必须保证在一个单元格内。如果冒出来一点都不行，不然引用过来的图片会有问题

xuemei0216

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
If Target = "" Then Exit Sub
If Target.Rows.Count > 1 Then Exit Sub
Dim rng As Range
With Sheet2
    Set rng = .Columns(1).Find(Target.Value, lookat:=xlWhole)
    If Not rng Is Nothing Then
        Dim shp As Shape
        For Each shp In ActiveSheet.Shapes
            If shp.TopLeftCell.Address = Target.Offset(0, 2).Address Then
                shp.Delete
            End If
        Next
        .Cells(rng.Row, 2).Copy Target.Offset(0, 2)
        Target.Offset(0, 2).Borders.LineStyle = 1
        For Each shp In ActiveSheet.Shapes
            If shp.TopLeftCell.Address = Target.Offset(0, 2).Address Then
                shp.Select
            End If
        Next
        With Selection.ShapeRange
            .LockAspectRatio = msoFalse
            .Left = Target.Offset(0, 2).Left + 2
            .Top = Target.Offset(0, 2).Top + 2
            .Width = Target.Offset(0, 2).Width - 4
            .Height = Target.Offset(0, 2).Height - 4
        End With
    End If
End With

End Sub

zpy2

这种感觉用sql比较方便。。。

657742868a

Sub 插入图片()
On Error Resume Next
    Dim rngTemp As Range, k As Range, picPath$, picTemp As Picture
    Dim Rng2 As Range
    Worksheets("Sheet1").Activate
    Set rngTemp = Application.InputBox("选择图片名称所在单元格：" & Chr(10) & "选择 '款号'", "款号", Type:=8)
    For Each k In rngTemp
        Set Rng2 = k.Offset(0, -1).Resize(1)
        Rng2.Select
        ActiveSheet.Pictures(k & k.Row).Delete
        picPath = ThisWorkbook.Path & "\图片8888\" & Trim(k) & ".jpg "
        Set picTemp = ActiveSheet.Pictures.Insert(picPath)
        picTemp.Name = k & k.Row
        picTemp.Placement = xlMoveAndSize
        With picTemp.ShapeRange
            .LockAspectRatio = msoFalse
            .Top = Rng2.Top
            .Left = Rng2.Left
            .Height = Rng2.Height
            .Width = Rng2.Width
        End With
        Set picTemp = Nothing
    Next
    添加缩放事件
End Sub

657742868a

可以套用