Aşağıdaki kodu internetten buldum. sırayla a1 a2 a3 hücrelerindeki değerleri K:\ sürücüsünde arayıp bulduğu resmi b1 b2 b3 hücrelerine ekliyor.
ancak K: içinde o hücredeki kodun resmi yoksa hata veriyor ve duruyor. Resmi bulamazsan durma bir sonrakine bak dedirtebileceğimiz şekile getirmek istiyorum. Yapabilecek kimse var mı?
Sub res()
For i = 1 To 4 Step 1
Cells(i, 2).Select
a = Cells(i, 1)
metin$ = "k:\" & a & ".jpg"
Set Adres = Range(ActiveWindow.RangeSelection.Address)
ActiveSheet.Pictures.Insert(metin).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.Top = Adres.Top + 2
Selection.Left = Adres.Left + 2
Selection.ShapeRange.Height = Adres.Height - 3
Selection.ShapeRange.Width = Adres.Width - 3
Cells(i + 1, 2).Select
Next i
End Sub
ancak K: içinde o hücredeki kodun resmi yoksa hata veriyor ve duruyor. Resmi bulamazsan durma bir sonrakine bak dedirtebileceğimiz şekile getirmek istiyorum. Yapabilecek kimse var mı?
Sub res()
For i = 1 To 4 Step 1
Cells(i, 2).Select
a = Cells(i, 1)
metin$ = "k:\" & a & ".jpg"
Set Adres = Range(ActiveWindow.RangeSelection.Address)
ActiveSheet.Pictures.Insert(metin).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.Top = Adres.Top + 2
Selection.Left = Adres.Left + 2
Selection.ShapeRange.Height = Adres.Height - 3
Selection.ShapeRange.Width = Adres.Width - 3
Cells(i + 1, 2).Select
Next i
End Sub
Sub res()
For i = 1 To 4 Step 1
Cells(i, 2).Select
a = Cells(i, 1)
metin$ = "K:\" & a & ".jpg"
Set Adres = Range(ActiveWindow.RangeSelection.Address)
If Dir$(metin) <> "" Then
ActiveSheet.Pictures.Insert(metin).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.Top = Adres.Top + 2
Selection.Left = Adres.Left + 2
Selection.ShapeRange.Height = Adres.Height - 3
Selection.ShapeRange.Width = Adres.Width - 3
End If
Cells(i + 1, 2).Select
Next i
End Sub
galadnikov
Kodların basina sub(res)'ten sonra "on error resume next" komutu ekleyip oyle deneyin. İsinizi gorecek olmali.
majesteleri84
1