yhomak
Yeni Üye
- Katılım
- 23 Haz 2021
- Mesajlar
- 23
- Çözümler
- 1
- Aldığı beğeni
- 4
- Excel V
- Office 2010 TR
Konu Sahibi
merhabalar aşağıdaki kodla ben isme göre bulunduğum sayfaya resim getirebiliyor. ama ben bulduğum sayfa yerine sayfa8 e resmi getirmesini istiyorum. bilgilerinize ihtiyacım var. TEŞEKKÜRLER
'worksheette bir değişiklik oldugunda bu kısım çalışıyor
Private Sub Worksheet_Change(ByVal Target As Range)
'değişiklik b sutunundamı olmuş diye kontrol et, değilse direk olarak fonksiyondan çık
If Intersect(Target, [E:E]) Is Nothing Then Exit Sub
'herhangi bir hata oluşursa Çıkış labelına git
On Error GoTo Çıkış:
' ilk olarak yüklü olan Resimleri silelim
ActiveSheet.Pictures.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
'b deki 2 ile 2 arasındaki satırları kontrol edip resim ataması yapıyoruz, siz burayı isteğinize göre artırabilirsiniz
For i = 8 To 8
'aktif sayfanın path bilgisini alıp, seçilen ürün idyi sonuna ekliyoruz ve dosyayı alıyoruz
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("E" & i) & ".jpg"
'dosya yok ise hataya düşmemek için aşağıdaki kontrolü yapıyoruz.
If DosyaVarmi(ResimDosyaYolu) Then
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("E" & i) & ".jpg"
Else
ResimDosyaYolu = ActiveWorkbook.Path & "\*.jpg"
End If
'resmi oluşturuyoruz.
Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
'Resmi boyutlandırıyoruz
With Range("K" & i)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
Next i
Çıkış:
End Sub
'worksheette bir değişiklik oldugunda bu kısım çalışıyor
Private Sub Worksheet_Change(ByVal Target As Range)
'değişiklik b sutunundamı olmuş diye kontrol et, değilse direk olarak fonksiyondan çık
If Intersect(Target, [E:E]) Is Nothing Then Exit Sub
'herhangi bir hata oluşursa Çıkış labelına git
On Error GoTo Çıkış:
' ilk olarak yüklü olan Resimleri silelim
ActiveSheet.Pictures.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
'b deki 2 ile 2 arasındaki satırları kontrol edip resim ataması yapıyoruz, siz burayı isteğinize göre artırabilirsiniz
For i = 8 To 8
'aktif sayfanın path bilgisini alıp, seçilen ürün idyi sonuna ekliyoruz ve dosyayı alıyoruz
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("E" & i) & ".jpg"
'dosya yok ise hataya düşmemek için aşağıdaki kontrolü yapıyoruz.
If DosyaVarmi(ResimDosyaYolu) Then
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("E" & i) & ".jpg"
Else
ResimDosyaYolu = ActiveWorkbook.Path & "\*.jpg"
End If
'resmi oluşturuyoruz.
Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
'Resmi boyutlandırıyoruz
With Range("K" & i)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
Next i
Çıkış:
End Sub