- 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.
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