首页 > 代码库 > execl 自动加载目录下图片
execl 自动加载目录下图片
在项目实施的过程中 ,给员工拍照了。但时候不好插在谁拍了,命名有没有错误等原因,需要直观的查看,并给员工自行验证
综合需求,在网上找个相关资料查看。然后根据实际情况汇总。得带的解决办法如下:
1、把人员信息相关导入
2、打开 execl 表的宏功能 ,新增宏
3、变形宏代码
代码如下:
Sub AutoAddPic()
Application.ScreenUpdating = False
For Each Shp In ActiveSheet.Shapes
If Shp.Type = msoPicture Then Shp.Delete
Next
Dim MyPcName As String, picTemp As Picture
For i = 2 To ThisWorkbook.ActiveSheet.UsedRange.Rows.Count
‘If (ActiveSheet.Cells(i, 1).Value = "http://www.mamicode.com/姓名") Then
‘ActiveSheet.Pictures().Delete ‘删除单元格中原来的图片
MyPcName = ActiveSheet.Cells(i, 1).Value & ActiveSheet.Cells(i, 3).Value & ".jpg"
ActiveSheet.Cells(i, 6).Delete
ActiveSheet.Cells(i, 6).Select
Dim MyFile As Object
Set MyFile = CreateObject("Scripting.FileSystemObject")
‘插入图片
If MyFile.FileExists(ThisWorkbook.Path & "\" & "人员信息" & "\" & MyPcName) = True Then
Set picTemp = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & "人员信息" & "\" & MyPcName)
‘picTemp.Name = k & k.Row ‘设定所插入图片的名称
picTemp.Placement = xlMoveAndSize ‘设置图片可以随单元格的变动而改变大小和位置
With picTemp.ShapeRange
.LockAspectRatio = msoFalse ‘取消图片纵横比锁定
.Height = Cells(i, 6).Height - 1 ‘设置所插入图片的高度与单元格的高度相等
.Width = Cells(i, 6).Width - 1 ‘设置所插入图片的宽度与单元格的宽度相等
End With
‘ picTemp.Select
Set picTemp = Nothing ‘重置图片对象
End If
‘If MyFile.FileExists(ThisWorkbook.Path & "\" & "人员信息" & "\" & MyPcName) = False Then
‘MsgBox ThisWorkbook.Path & "\" & "111" & "\" & MyPcName & "暂无图片"
‘Else
‘ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & "人员信息" & "\" & MyPcName).Select
‘End If
‘ End If
Next i
Application.ScreenUpdating = True
End Sub
execl 自动加载目录下图片