-
- Destek
-
Özel Arama
![]() |
With ActiveSheet.Pictures.Insert("resim yolu")
.Left = 500
.Top = 700
.Width = 123
.Height = 134
End With
End If
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c6]) Is Nothing Then Exit Sub
'ActiveSheet.DrawingObjects.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("c6") & ".gif"
Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
With Range("g10")
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
End Sub
ActiveSheet.Pictures.Delete
tasad yazdı:Sheet2 kod bölümünü tamamen sil ve aşağıdaki kodları kaydet.
- Kod: Tümünü seç
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c6]) Is Nothing Then Exit Sub
'ActiveSheet.DrawingObjects.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("c6") & ".gif"
Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
With Range("g10")
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
End Sub
muhit01 yazdı:tasad yazdı:Sheet2 kod bölümünü tamamen sil ve aşağıdaki kodları kaydet.
- Kod: Tümünü seç
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c6]) Is Nothing Then Exit Sub
'ActiveSheet.DrawingObjects.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("c6") & ".gif"
Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
With Range("g10")
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
End Sub
tasad ve rastbin hocam ikinizede teşekkürlerimi sunarım .
evet tasad hocamın verdiği kod süper oldu rastbin hocam sizde haklısınız denedim şimdi resimleri üst üste kaydediyor verdiğiniz kodu tasad hocamın verdiği kodun en başına yapıştırdıgımda hata veriyor nasıl düzeltebilirim acaba
ikinizede saygılarımı sunarım .
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c6]) Is Nothing Then Exit Sub
ActiveSheet.Pictures.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
ResimDosyaYolu = ThisWorkbook.Path & "\resimler\" & Range("c6") & ".gif"
Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
With Range("g10")
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
End Sub
muhit01 yazdı:hocalarım çok özür dilerim bir noktada daha değerli yardımlarınıza ihtiyacım var .
çalışma sayfası ile resimler aynı klasörde dolaysiyle resimler çoğaldıkça sorun olacak sanıyorum
çalışma sayfasının bulunduğu klasör içine ( RESİMLER ) isminde bir klasör daha oluşturup resimleri o klasör içinden çağırmak istiyorum
kodda nasılbir değişiklik yapmam gerek acaba
Saygılar.
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("c6") & ".gif"
ResimDosyaYolu = ActiveWorkbook.Path & "\RESİMLER\" & Range("c6") & ".gif"
şahin yazdı:Dosyanız ekte. Klasörden resmi isim üzerinden değilde sicil no üzerinden arama yapacak, birden fazla aynı isimde kişi olabileceğinden dolayı..
şahin yazdı:Ekte
muhit01 yazdı:şahin yazdı:Ekte
Şahin Hocam merhaba ,
çok teşekkür ederim elinize sağlık hocam.
hocam veriler yerine oturuyor fakat resimler personele göre değişmiyor nasıl düzeltebilirim şahin hocam
saygılarımla .
şahin yazdı:Klasörü zip dosyasından çıkarın masüstüne c: veya d: nin içerisine orada çalıştırın.
şahin yazdı:Ahmet Türkmen ile Mustaf ünlünün resimleri var, aşağıdaki zip.indirin klsörü çıkartın yeniden deneyin, ne hatası verecek bakalım, bende çalışıyor, birde makro güvenlik ayarlarını kontrol edin..
Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 2 misafir