Masa üstü klasörden pdf dosyasının görüntüsü Excele alma

[izcik]

dosya = Dir(yol & [a1] & "~*.pdf") Örnek dosyada a1 hücresinde dosya adı var. A1 hücresine dosyanızın adını yazınız.

Sayın uzmanım olmuyor bir türlü.
A1 hücresine 1234 yazdım olmadı
A1 hücresine 1234.pdf yazdım olmadı

Sizden rica etsem
Masaüstündeki DENEME
isimli klasörün içindeki
1234 isimli pdf yi excele aktaracak kodları yazar mısınız?

 

[leumruk]

Sub Makro1()
For Each rsm In ActiveSheet.Pictures
    If Not Intersect(rsm.TopLeftCell, Range("A4")) Is Nothing Then
        rsm.Delete
    End If
Next
Range("A4").Select
'yol = ThisWorkbook.Path & "\"
yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DENEME\"
dosya = Dir(yol & [a1] & ".pdf")
If dosya <> "" Then
    ActiveSheet.OLEObjects.Add(Filename:=yol & dosya, Link:=False, DisplayAsIcon:=False).Select
Else
MsgBox "Aradığınız isimde dosya bulunmamaktadır.", vbOKOnly, "l e u m r u k"
End If
End Sub

yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DENEME\"
dosya = Dir(yol & [a1] & ".pdf")

Düzenlenen kod satırı

 

[izcik]

Sub Makro1()
For Each rsm In ActiveSheet.Pictures
    If Not Intersect(rsm.TopLeftCell, Range("A4")) Is Nothing Then
        rsm.Delete
    End If
Next
Range("A4").Select
'yol = ThisWorkbook.Path & "\"
yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DENEME\"
dosya = Dir(yol & [a1] & ".pdf")
If dosya <> "" Then
    ActiveSheet.OLEObjects.Add(Filename:=yol & dosya, Link:=False, DisplayAsIcon:=False).Select
Else
MsgBox "Aradığınız isimde dosya bulunmamaktadır.", vbOKOnly, "l e u m r u k"
End If
End Sub

yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\DENEME\"
dosya = Dir(yol & [a1] & ".pdf")

Düzenlenen kod satırı

Şimdi oldu uzmanım
Sağolunuz

 

[leumruk]

Şimdi oldu uzmanım
Sağolunuz

Rica ederim.