如何自动插入图片及调整大小

蓝星魂

各位大神，
如果可以自动插入图片及调整大小，请指教～～


要求：
在G列到M列
1.如输入"F001",即自动插入此文件路径&"\pic"的“F001.JPG"的图片
2.插入的图片按单元格自动调节大小

chenjx80

你要哪一种？
输入后立即显示图片
链接:https://pan.baidu.com/s/1T7ZgI3AOYns4yqiIajlxfw 密码:qmjh
批量插入图片
链接:https://pan.baidu.com/s/119h4Y5Qj_UgFb6nBtwMZtA 密码:9zj2
批量递归插入图片
链接:https://pan.baidu.com/s/12NIH49gpJqxklonkyPOkRg 密码:86ej

蓝星魂

chenjx80 发表于 2018-8-1 20:00
你要哪一种？
输入后立即显示图片
链接:https://pan.baidu.com/s/1T7ZgI3AOYns4yqiIajlxfw 密码:qmjh

这个没有代码的？？
可否给我写个代码看看呢

liulang0808

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count <> 1 Then Exit Sub
   
3.     If Len(Target) = 0 Then Exit Sub
   
4.     If InStr(Cells(1, Target.Column), "图片") > 0 Then
   
5.         Set photo = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\pic" & Target & ".jpg")
   
6.         With photo
   
7.           .Name = sFile
   
8.           .ShapeRange.LockAspectRatio = msoFalse
   
9.           .Top = Target.Top
   
10.           .Left = Target.Left
    
11.           .Width = Target.Width
    
12.           .Height = Target.Height
    
13.         End With
    
14.     End If
    
15. End Sub
    

复制代码

liulang0808

对文件是否存在没有判断，楼主可以自行增加判断的

蓝星魂

liulang0808 发表于 2018-8-1 20:44
对文件是否存在没有判断，楼主可以自行增加判断的

谢谢，剩下的自已加代码去了

蓝星魂

liulang0808 发表于 2018-8-1 20:43

老师，再请教一下
如果target的内容更变了，可自动将原来的图片自动删除吗？
.Name=.sFile
这个sFile没有定义，好像也没用，我直接删了
有劳指教
谢谢～

liulang0808

蓝星魂 发表于 2018-8-2 11:03
老师，再请教一下
如果target的内容更变了，可自动将原来的图片自动删除吗？
.Name=.sFile

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Len(Target) = 0 Then Exit Sub
    If InStr(Cells(1, Target.Column), "图片") > 0 Then
        For Each sh In ActiveSheet.Shapes
            If sh.Top = Target.Top And sh.Left = Target.Left Then
                sh.Delete
                Exit For
            End If
        Next sh
        Set photo = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\pic\" & Target & ".jpg")
        With photo
          .Name = sFile
          .ShapeRange.LockAspectRatio = msoFalse
          .Top = Target.Top
          .Left = Target.Left
          .Width = Target.Width
          .Height = Target.Height
        End With
    End If
End Sub

liulang0808

附件内容供参考。。。。。。

563406396

liulang0808 发表于 2018-8-1 20:43

版主，如果我需设置插入到C列，图片宽度和C列单元格一致，自动调整行高匹配图片大小，该怎么弄？