Resim Ekleme Makro hatası

[Huseyinkis]

Sub Tıkla()
Dim sPicture As String, pic As Picture
For i = 1 To 10
Cells(i, 5).Select
aaa = Range("E" & i).Value
sPicture = ("C:\Users\huseyin\Pictures\" & aaa & ".gif")
On Error GoTo atla3:
GoTo atla2:
atla3:
sPicture = ("C:\Users\huseyin\Pictures\none.gif")
atla2:
Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = ActiveCell.Height
.Width = ActiveCell.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With
Set pic = Nothing
Next i
End Sub

On Error GoTo atla3:

Bu işlem eğer istenilen isimde resim yoksa ilk hata için çalışıyo fakat next döngüsü başa donup 2 kez hata verdiğinde işlem yapmıyor. verilen linkte resim olup olmadığını başka nasıl kontrol edebilirim.

 

[hamitcan]

sPicture = ("C:\Users\huseyin\Pictures\" & aaa & ".gif")
If Dir(sPicture) = "" Then msgbox "Böyle bir dosya yok":exit sub

şeklinde deneyin.

 

[kocaeliartvin]

Hüseyin bey siz on error go to hata ve hata satırlarını silin ve aşağıdaki şekilde kodu güncelleyin. çalıştığını göreceksiniz. Tecrübeyle sabittir.

Ayrıca teşekkür ederim )


sPicture = ("e:\Malzeme Resim\Küçük Resim\" & [ab1] & ".jpg")
If Dir(sPicture) = "" Then sPicture = ("e:\Malzeme Resim\Küçük Resim\none.jpg")

 

[Huseyinkis]

Hüseyin bey siz on error go to hata ve hata satırlarını silin ve aşağıdaki şekilde kodu güncelleyin. çalıştığını göreceksiniz. Tecrübeyle sabittir.

Ayrıca teşekkür ederim )


sPicture = ("e:\Malzeme Resim\Küçük Resim\" & [ab1] & ".jpg")
If Dir(sPicture) = "" Then sPicture = ("e:\Malzeme Resim\Küçük Resim\none.jpg")

Sayın hamitcan hocama tesekkurler.

Sayın kocaeliartvin sizede teşşekkürler sorununuz sanırım cözüldü..

 

[kocaeliartvin]

evet çözüldü. teşekkür ederim hüseyin bey

 

[orgatu]

sPicture = ("C:\Users\huseyin\Pictures\" & aaa & ".gif")
If Dir(sPicture) = "" Then msgbox "Böyle bir dosya yok":exit sub

şeklinde deneyin.

merhabalar.
burada, = ("C:\Users\huseyin\Pictures\" & aaa & ".gif") aaa dosya isminin ilk kelimesi olsaydı, dosyaadının aaa dan sonraki kelimeleri nasıl yok sayabileceğiz.

anlatabildimmi bilemiyorum.

yani resimi getirilecek dosyanın ilk kelimesine göre aramanın nasıl yapılacağını öğrenmek istiyorum..

 

[hamitcan]

Sorunuz anlaşılmıyor, biraz daha açıklama yapın yada bir örnek ile açıklayın.

 

[orgatu]

şu adreste bir örneğim mevcuttur.

http://www.excel.web.tr/f48/resim-getirme-t104408.html

 

[hamitcan]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ds, dc, f, s
    On Error Resume Next
    ActiveSheet.Pictures.Delete
    If Target.Column <> 1 Then Exit Sub
'    ActiveSheet.Pictures.Insert ("C:\Documents and Settings\All Users\Belgeler\Resimlerim\Örnek Resimler\" & Target & ".jpg") 'Resimlerinizin bulunduğu yolu yazın.
    Set ds = CreateObject("Scripting.FileSystemObject")
    Set f = ds.GetFolder("C:\Documents and Settings\All Users\Belgeler\Resimlerim\Örnek Resimler\")
    Set dc = f.Files
    For Each dosya In dc
    a = StrConv(Left(dosya.Name, Len(Target.Text)), vbUpperCase)
    b = StrConv(Target.Text, vbUpperCase)
    If a = b Then
    ActiveSheet.Pictures.Insert ("C:\Documents and Settings\All Users\Belgeler\Resimlerim\Örnek Resimler\" & dosya.Name)     'Resimlerinizin bulunduğu yolu yazın.
    End If
    Next
End Sub