|
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim rngA As Range, cell As Range
Dim photoFolder As String
Dim fileName As String
Dim filePath As String
Dim objOLE As OLEObject
Dim insertRow As Integer
' 设置工作表和相片文件夹路径
Set ws = ThisWorkbook.Sheets("Sheet1") ' 更改工作表名称为实际使用的名称
photoFolder = "D:\pdf文件\" ' 更改为实际的相片文件夹路径
' 获取A列范围
Set rngA = ws.Range("A5:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
' 遍历每个非空单元格
For Each cell In rngA
If cell.Value <> "" Then
' 获取文件名
fileName = cell.Value
' 构建文件路径
filePath = photoFolder & fileName & ".pdf"
' 检查文件是否存在
If Dir(filePath) <> "" Then
' 确定要插入的行数,这里假设B列中有空行可用
insertRow = cell.Row
' 插入OLE对象
Set objOLE = ws.OLEObjects.Add(fileName:=filePath, Link:=False, DisplayAsIcon:=False, _
Left:=ws.Cells(insertRow, "B").Left, Top:=ws.Cells(insertRow, "B").Top, _
Width:=100, Height:=100)
Else
MsgBox "文件 " & fileName & " 不存在!"
End If
End If
Next cell
End Sub
|
|