Excel表格 宏 批量添加图片

通过vba处理，需要卡率的来源及的名称关系

插入后调整大小即可

放在当前代码文件所在文件夹下，如果不是，可以根据实际情况修改路径。

后面j列什么的，同理调整即可，很简答的。

具体的说就是。比如A1的值为china，那么B1就自动填充d:\pic\下的"chinapng"
2\3\4……各行也一样。
应该是用宏填充单元格吧，可是我不会。
最好能是即时显示，输入china，就显示。
谢谢了。最好给出源码

根据照片编码导入，所在文件夹程序会让你选。
Sub 导入()
Dim shp As Shape
Dim r As Integer
Dim fld As String '所在文件夹
Dim PicPath As String '名称所在目录
Dim Picrng As Range '导入单元格
'选择文件夹，默认是当前工作簿所在文件夹
With ApplicationFileDialog(msoFileDialogFolderPicker)
If Show = -1 Then
fld = SelectedItems(1)
Else
fld = ThisWorkbookPath
End If
End With
With ActiveSheet
For r = 3 To Range("F6000")End(xlUp)Row Step 21
PicPath = fld & "\" & Range("F" & r)Text & "jpg" ''JPG格式
If Dir(PicPath) <> "" Then
Set shp = ShapesAddPicture(PicPath, False, True, 0, 0, -1, -1)
Set Picrng = Range("D" & r) '设定单元格在D列
With shp
LockAspectRatio = msoFalse '纵横比可调整
Top = PicrngTop + 1
Left = PicrngLeft + 1
Width = PicrngWidth 17 - 3
Height = PicrngHeight - 3
End With
End If
Next r
End With
Set shp = Nothing
Set Picrng = Nothing
End Sub

1、打开Excel，准备好表格。

2、在工作表中，点击菜单栏开发工具，在其工具栏内，点击visual basic。

3、接着点击菜单栏插入，在其下拉菜单中，选择模块。

4、在d出模块编辑窗口填入代码：Sub 导入()Dim sp As Shape, rng As Range, rg As Range, arg As RangeFor Each sp In Sheets("插入")ShapesIf spType <> 8 ThenspDelete

Next spSet arg = Columns("a")End(xlDown)For Each rng In Range([a2], arg)pah = thisworkbookPath & "\tupian\" & rngValue & "jpg"。

5、在工作表的开发工具菜单下，插入一表单按钮，并与指定编写的插入代码关联，且进入命名为导入。

6、点击导入按钮，被瞬间导入。就完成了。

如下代码可插入到指定单元格。
Range("a1")Select '选中A1单元格
ActiveSheetShapesAddShape(msoShapeRectangle, Range("a1")Left, _
Range("a1")Top, Range("a1")Width, Range("a1")Height)Select
SelectionShapeRangeFillUserPicture picpath '在A1单元格插入，大小与单元格一样。
VBA是Visual Basic for
Applications的缩写，是内嵌于office软件中的一个开发模块，这个模块提供程序自主开发，语言基础和VB（Visual
Basic）相似。在Excel的“工具—宏—编辑器”可以打开，也可按Alt+F11打开

---