Excel输入内容时自动插入图片

1、点击【开发工具】、【Visual Basic】。

2、在VBA工程项目下方双击“Sheet1”。

3、Sheet1代码框里边输入以下VBA程序代码。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i, arr, str, typ, shp

On Error Resume Next               '忽略运行中可能出现的错误

Application.EnableEvents = False   '关闭触发连锁事件

Application.ScreenUpdating = False '关闭工作表更新，提高运行速度

If Target.Row < 1000 And Target.Column = 1 And Target.Count = 1 Then

'如果改变的单元格在A1:A999且只是1个单元格，则

i = Target.Row                                                '追踪单元格所在的行

Set mysheet1 = ThisWorkbook.Worksheets("Sheet1")              '定义Sheet1工作表

arr = Array(".jpg", ".jpeg", ".png", ".bmp", ".gif", ".tif")  '图片格式集合

For Each shp In mysheet1.Shapes       '扫描工作表里面的每一张图片

 If shp.Top > mysheet1.Cells(i, 6).Top And shp.Top < mysheet1.Cells(i + 1, 6).Top Then

  shp.Delete                          '如果是追踪单元格对应的E列单元格里边的图片，则删除

 End If

Next

 If mysheet1.Cells(i, 1) <> "" Then   '如果A列改变的单元格不为空白，则执行

  For Each typ In arr                 '执行图片格式组里面的每一个尝试

   str = "D:\ABCDE\" & mysheet1.Cells(i, 1).Value & typ  '图片路径（D盘ABCDE文件夹里边）

    If Dir(str) <> "" Then                               '如果图片存在，则执行

     mysheet1.Pictures.Insert(str).Select         '插入图片并选择

     With Selection.ShapeRange

        .LockAspectRatio = msoFalse               '不锁定图片的比例

        .Height = mysheet1.Cells(i, 6).Height - 6 '图片的高度设为单元格高度-6

        .Width = mysheet1.Cells(i, 6).Width - 6   '图片的宽度设为单元格高度-6

        .Top = mysheet1.Cells(i, 6).Top + 3       '图片的位置为E列对应单元格到顶部的距离+3

        .Left = mysheet1.Cells(i, 6).Left + 3     '图片的位置为E列对应单元格到左侧的距离+3

     End With

      Exit For                                    '导入图片后，退出For循环

    Else

     mysheet1.Cells(i, 6) = "图片不存在"          '否则将显示“图片不存在”

    End If

  Next

 Else

  mysheet1.Cells(i, 6) = ""        '清空E列对应单元格的内容

 End If

 mysheet1.Cells(i + 1, 1).Select   '选择下一单元格

End If

Application.ScreenUpdating = True  '恢复更新显示

Application.EnableEvents = True    '恢复触发连锁事件

End Sub

4、回到Excel工作表界面，在A列的单元格里边输入内容。

5、E列相应的单元格将会自动插入图片。