返回目录：excel表格制作
材料/工具：电脑、Excel2007
1、首先，打开Excel表格，点击表格最左上边office按钮---excel选项 。
2、弹出来一个对话框，点击”常用“栏目，右侧出现常用对话框，我们知找到一个叫做“在功能区显示开发者选项卡”，点击勾选它。点击确定。
3、回到道打开表格的开始页面，将表格中图片那一列填充对应的款号或编码，注意要插入图片的内表格里边在插入图片之前是有编号的，里边的编号就是对应的款号。如图所示点击”Visual Basic“ 快捷键是”ALT+F11 “。
4、然后点击 ”文件“，选择”导入文件“。
5、导入后文件后，窗口上方有一排”宏“的指令，点那个绿色的三角运行"宏" 三角按钮就是经常用到容的”开始/播放“那个按钮点，然后跳出一个对话框，点击”运行“。
6、我们要导入图片的位置，就是把图片存在我们电脑上的哪个位置复制下来填进方框里边去，复制 粘贴就可以了。也可以手动输入进去，但是完成后，一定记得再加一个“\”点确定。
7、点击确定，对话框关闭。我们就回到开始页面了，这时发现我们已经将图片导入表中对应的款式去了。
图片和excel工作薄必须在同一个文件夹下
假设输入内容的单元格在第一列
在工作表名7a686964616fe59b9ee7ad94361称上点右键选查看代码,粘贴以下代码到弹出窗口.关闭弹出窗口
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
sfileName = ThisWorkbook.Path & "\" & Target.Value & ".jpg"
On Error GoTo err01
With Target.Offset(0, 1)
Shapes.AddPicture(sfileName, True, True, .Left, .Top, .Width, .Height).Select
Selection.Placement = xlMoveAndSize
End With
End If
Cells(1, 1).Select
Exit Sub
err01:
If err.Number = 1004 Then MsgBox "当前目录下没有名称为:" & Target.Value & ".jpg,的图片"
End Sub
根据照片名称自动插入图片，这位朋友的宏正好可以用上，适当修改参数就可以用了。
代码如下先给你，我先声明下，我也是之前需要这个操作在网上找的，可以实现你的功能，很好用。
具体用法：
打开excel的VB，把代码复制进去。
在A列输入需要插入照片的名称，然后选定这些有名称的单元格（重点！要选定）。
然后运行宏，在弹出的对话框选【否】，意思就是在名称的右边插入图片，上面的汉字应该也能看懂。
然后会出来一个对话框让你选择路径，选择你放照片的那个文件夹，点击文件夹里的任意一张照片点【打开】。
然后照片就插进去了，而且是每张照片都e68a84e799bee5baa6e997aee7ad94339填满单元格。
建议提前把单元格的大小设置好然后再运行宏。
如下看我的示例，功能真鸡儿强大，再次膜拜下VB大神。
Sub A()
Dim Rng As Range
Set Rng = Selection
K = MsgBox("Yes=按姓名行下插入，No=按姓名列右挿入,Cancel=直接覆盖插入", vbYesNoCancel)
If K = vbYes Then
r = 1: c = 0
ElseIf K = vbNo Then
r = 0: c = 1
Else
r = 0: c = 0
End If
Pf = "ai,"
Pf = Pf & "bmp,bmz"
Pf = Pf & "cdr,cgm,"
Pf = Pf & "dib,dwg,dxf,"
Pf = Pf & "emf,emz,eps,exf,exif,"
Pf = Pf & "fpx,"
Pf = Pf & "gfa,gif,"
Pf = Pf & "hdr,"
Pf = Pf & "ico,"
Pf = Pf & "jfif,jpe,jpeg,jpg,"
Pf = Pf & "pcd,pct,pcx,pcz,pict,png,psd,"
Pf = Pf & "raw,rle,"
Pf = Pf & "svg,"
Pf = Pf & "tga,tif,tiff,"
Pf = Pf & "ufo,"
Picformat = Pf & "wdp,wmf,wmz,"
OpenFile = Application.GetOpenFilename("Picture Files(*.*),*.*", , "打开目的档案夹後选择任一图片即可指定资料夹。或按取消则会将当前档所在资料夹认作指定资料夹。")
If OpenFile = False Then
myDir = ThisWorkbook.Path & "\"
Else
myDir = Left(OpenFile, InStrRev(OpenFile, "\"))
End If
Application.ScreenUpdating = False
Filename = Dir(myDir)
Do While Filename <> ""
If InStr(Picformat, LCase(Right(Filename, Len(Filename) - InStrRev(Filename, ".")))) > 0 Then
PicName = Left(Filename, InStrRev(Filename, ".") - 1)
Rng.Select
On Error Resume Next
Selection.Find(What:=PicName, After:=ActiveCell, LookAt:=xlWhole).Activate
If Err.Number <> 0 Then
Err.Clear
Else
ActiveSheet.Pictures.Insert(myDir & Filename).Select
With Selection
.Placement = xlMoveAndSize
.ShapeRange.LockAspectRatio = msoFalse
.Top = ActiveCell.Offset(r, c).Top
.Left = ActiveCell.Offset(r, c).Left
.Height = ActiveCell.Offset(r, c).Height
.Width = ActiveCell.Offset(r, c).Width
End With
End If
End If
Filename = Dir
Loop
Rng.Select
End Sub