原创商品工作人员必备技能第五节批量导入图片可以选存放文件夹可以选择图片的位置1.docx

1、原创商品工作人员必备技能第五节批量导入图片可以选存放文件夹可以选择图片的位置1原创商品工作人员必备技能(第五节)批量导入图片(可以选存放文件夹-可以选择图片的位置)-(1)原创商品工作人员必备技能（第五节）批量导入图片（可以选存放文件夹,可以选择图片的位置）商品日常工作中无论是订单制作，销售排行榜、畅滞销排行、还是主推款介绍等等都会要求插入图片，一个一个插入会很麻烦，所以使用VBA语句会很简单也会很容易达成。下面讲解如何使用语句插入图片：第一步：将单元格大小调整好，图形插入的时候会自动根据单元格大小调整图片大小。第二步：选中要插入图片的对应款号单元格，不要图省事直接选中列，那样你的电脑会被卡死

2、的第三步：在工作表名字标签上单击鼠标右键，在弹出的菜单上选中查看代码并单击第四步：将复制的执行语句粘贴到弹出的VB编辑器中的空白处，第五步：点击绿色箭头或者按F5执行语句第六步：在弹出来的浏览窗口找到图片所在文件夹后，点确定第七步：在弹出来的指定位置的选项中填入对应的数字，然后点确定。这个选项很多人说看不懂因此单独解释一下：图片位置是单元格上面输入数字1，图片位置是单元格下面输入数字2，图片位置是单元格左面输入数字3，图片位置是单元格右面输入数字4。第八步：调整图片大小适应单元格，或者调整单元格大小。第九步：删除VB编辑器里面的语句，然后关闭VB编辑器，保存文件。如果不删除语句会有疑似病毒提示

3、。5-3 批量导入图片（可以选存放文件夹,可以选择图片的位置）Sub AAA() On Error Resume Next Dim T As String, FD Dim MR As Range Set FD = Application.FileDialog(msoFileDialogFolderPicker) 允许用户选择一个文件夹 If FD.Show = -1 Then T = FD.SelectedItems(1) 选择之后就记录这个文件夹名称 Else Exit Sub 否则就退出程序 End If p = InputBox(请选择图片插入位置，上，下，左，右依次用1，2，3，4代替

4、, 请选择位置) Set fso = CreateObject(scripting.filesystemobject) For Each MR In Selection If Not IsEmpty(MR) Then pic = T & & MR.Value & .jpg If fso.FileExists(pic) Then MR.Select If (p = 1) Then 上 ML = MR.Left MT = MR.Top - MR.Height MW = MR.Width MH = MR.Height ElseIf (p = 2) Then 下 ML = MR.Left MT = M

5、R.Top + MR.Height MW = MR.Width MH = MR.Height ElseIf (p = 3) Then 左 ML = MR.Left - MR.Width MT = MR.Top MW = MR.Width MH = MR.Height ElseIf (p = 4) Then 右 ML = MR.Left + MR.Width MT = MR.Top MW = MR.Width MH = MR.Height End If ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select Se

6、lection.ShapeRange.Fill.UserPicture pic 当前文件所在目录下以当前单元内容为名称的.jpg图片 End If End If NextEnd Sub5-4 批量导入图片（可以选存放文件夹,图片放在右边单元格）Sub AAA() On Error Resume Next Dim T As String, FD Dim MR As Range Set FD = Application.FileDialog(msoFileDialogFolderPicker) 允许用户选择一个文件夹 If FD.Show = -1 Then T = FD.SelectedItem

7、s(1) 选择之后就记录这个文件夹名称 Else Exit Sub 否则就退出程序 End If Set fso = CreateObject(scripting.filesystemobject) For Each MR In Selection If Not IsEmpty(MR) Then pic = T & & MR.Value & .jpg If fso.FileExists(pic) Then MR.Select ML = MR.Left + MR.Width MT = MR.Top MW = MR.Width MH = MR.Height ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select Selection.ShapeRange.Fill.UserPicture pic 当前文件所在目录下以当前单元内容为名称的.jpg图片 End If End If NextEnd Sub