Soru SAYFADAN RESİM GETİRME VE İLGLİ SÜTÜNDA OTOMATİK GÜNCELEME

Katılım
26 Ocak 2018
Mesajlar
13
Excel Vers. ve Dili
excel 2016
Altın Üyelik Bitiş Tarihi
22-03-2023
Sayın üstatlar,
Makro konusunda , çok uzman olmamakla beraber; aşağıda özetlemeye çalıştığım şekliyle belki basit belki zor bir soru soracağım.

soru : aşağıda vermiş olduğum kod dizilimde yer alan dosya yolundan resimleri değil doğrudan sayfada resimleri çekilmesi mümkün olur mu ?​
Kod:
Public Function DosyaVarmi(dosyayolu As String) As Boolean
    On Error GoTo Çıkış
    If Not Dir(dosyayolu, vbDirectory) = vbNullString Then DosyaVarmi = True
    
Çıkış:
    On Error GoTo 0
End Function

'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, [F:F]) 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 5 ile 12 arasındaki satırları kontrol edip resim ataması yapıyoruz, siz burayı isteğinize göre artırabilirsiniz
For i = 2 To 41
    'aktif sayfanın path bilgisini alıp, seçilen ürün idyi sonuna ekliyoruz ve dosyayı alıyoruz
    ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("F" & i) & ".png"

    'dosya yok ise hataya düşmemek için aşağıdaki kontrolü yapıyoruz.
    If DosyaVarmi(ResimDosyaYolu) Then
         ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("F" & i) & ".png"
        Else
           ResimDosyaYolu = ActiveWorkbook.Path & "\-.png"
        End If
        
    'resmi oluşturuyoruz.
     Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
     'Resmi boyutlandırıyoruz
     With Range("G" & i)
     Resim.ShapeRange.LockAspectRatio = msoFalse
     Resim.Top = .Top
     Resim.Left = .Left
     Resim.Height = .Height
     Resim.Width = .Width
     Resim.Placement = xlMoveAndSize
     End With

Next i

Çıkış:

End Sub
 
Katılım
26 Ocak 2018
Mesajlar
13
Excel Vers. ve Dili
excel 2016
Altın Üyelik Bitiş Tarihi
22-03-2023
özür dilerim excel dosya linki aşağıdaki link üzerine yüklenmiştir.

dosya linki
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,190
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
İnceleyiniz.

 
Üst