Kısa Açıklama
Resim Uzantısını Birden Fazla Uzantı Olarak Çekme isimli başlıkta, ilgili işlemlere dair detaylar yer almaktadır.- Excel Versiyonu
- Excel 2016
- Excel Sürümü
- 64 Bit
- Excel Dili
- Türkçe
Aşağıdaki bu kodda .jpg , .png , .jpeg veya .gif olan uzantıları da aynı anda çekmesini istiyorum ama olmadı
"*.jpg; *.png; *.jpeg" olarak denedim olmadı çekmedi. Birde resim boyutlandıması yaptığımız ürünü nasıl ortalama yapabilirim.
ResimDosyaYolu = ActiveWorkbook.Path & "\IMG\" & Range("b" & i) & ".jpg"
'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, [b:b]) 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.DrawingObjects.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
'b deki 2 ile 1237 arasındaki satırları kontrol edip resim ataması yapıyoruz, siz burayı isteğinize göre artırabilirsiniz
For i = 2 To 1237
'aktif sayfanın path bilgisini alıp, seçilen ürün idyi sonuna ekliyoruz ve dosyayı alıyoruz
ResimDosyaYolu = ActiveWorkbook.Path & "\IMG\" & Range("b" & i) & ".jpg"
'dosya yok ise hataya düşmemek için aşağıdaki kontrolü yapıyoruz.
If DosyaVarmi(ResimDosyaYolu) Then
ResimDosyaYolu = ActiveWorkbook.Path & "\IMG\" & Range("b" & i) & ".jpg"
Else
ResimDosyaYolu = ActiveWorkbook.Path & "\IMG\urunyok2.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 = 60
Resim.Width = 100
End With
Next i
Çıkış:
"*.jpg; *.png; *.jpeg" olarak denedim olmadı çekmedi. Birde resim boyutlandıması yaptığımız ürünü nasıl ortalama yapabilirim.
ResimDosyaYolu = ActiveWorkbook.Path & "\IMG\" & Range("b" & i) & ".jpg"
'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, [b:b]) 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.DrawingObjects.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
'b deki 2 ile 1237 arasındaki satırları kontrol edip resim ataması yapıyoruz, siz burayı isteğinize göre artırabilirsiniz
For i = 2 To 1237
'aktif sayfanın path bilgisini alıp, seçilen ürün idyi sonuna ekliyoruz ve dosyayı alıyoruz
ResimDosyaYolu = ActiveWorkbook.Path & "\IMG\" & Range("b" & i) & ".jpg"
'dosya yok ise hataya düşmemek için aşağıdaki kontrolü yapıyoruz.
If DosyaVarmi(ResimDosyaYolu) Then
ResimDosyaYolu = ActiveWorkbook.Path & "\IMG\" & Range("b" & i) & ".jpg"
Else
ResimDosyaYolu = ActiveWorkbook.Path & "\IMG\urunyok2.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 = 60
Resim.Width = 100
End With
Next i
Çıkış: