如何从指定文件夹中导入扩展名不同的照片？

作者：绿色风分类：时间：2022-08-17 浏览：87

楼主
lrlxxqxa

Q：如何从指定文件夹中导入扩展名不同的照片？

A：

Sub insertPic()
Dim i As Integer
Dim FilPath As String
Dim rng As Range
Dim s As String
With Sheet1
For i = 1 To .Range("a65536").End(xlUp).Row
FilPath = ThisWorkbook.Path & "\学生相片\" & .Cells(i, 1).Text & ".jpg.jpg"
If Dir(FilPath) <> "" Then
100:
.Pictures.Insert(FilPath).Select
Set rng = .Cells(i, 2)
With Selection
.Top = rng.Top + 1
.Left = rng.Left + 1
.Width = rng.Width - 1
.Height = rng.Height - 1
End With
Else
FilPath = ThisWorkbook.Path & "\学生相片\" & .Cells(i, 1).Text & ".jpg.gif"
GoTo 100
s = s & Chr(10) & .Cells(i, 1).Text
End If
Next
.Cells(1, 1).Select
End With
If s <> "" Then
MsgBox s & Chr(10) & "没有照片!"
End If
End Sub
Sub DeletePic()
Dim myShape As Shape
For Each myShape In Sheet1.Shapes
If myShape.Type <> 8 Then
myShape.Delete
End If
Next
End Sub

该贴已经同步到

相片导入lr.rar

2楼
lrlxxqxa

谢谢莫莫的完善

相片的格式不统一，同时由于隐藏后缀名，有些是gif，有些是jpg，还有可能有考虑不到的格式图片出现，将代码改成模糊匹配图片格式

Sub insertPic()
Dim i As Integer
Dim FilPath As String
Dim rng As Range
Dim s As String
With Sheet1
For i = 1 To .Range("a65536").End(xlUp).Row
FilPath = ThisWorkbook.Path & "\学生相片\" & .Cells(i, 1).Text & ".jpg.jpg"
If Dir(FilPath) <> "" Then
100:
.Pictures.Insert(FilPath).Select
Set rng = .Cells(i, 2)
With Selection
.Top = rng.Top + 1
.Left = rng.Left + 1
.Width = rng.Width - 1
.Height = rng.Height - 1
End With
Else
FilPath = ThisWorkbook.Path & "\学生相片\" & .Cells(i, 1).Text & ".jpg.gif"
GoTo 100
s = s & Chr(10) & .Cells(i, 1).Text
End If
Next
.Cells(1, 1).Select
End With
If s <> "" Then
MsgBox s & Chr(10) & "没有照片!"
End If
End Sub
Sub DeletePic()
Dim myShape As Shape
For Each myShape In Sheet1.Shapes
If myShape.Type <> 8 Then
myShape.Delete
End If
Next
End Sub

相片导入（小莫修改版）.rar

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表