- Katılım
- 12 Kasım 2014
- Mesajlar
- 255
- Excel Vers. ve Dili
- 2013
- Altın Üyelik Bitiş Tarihi
- 15-05-2023
Merhaba,
Hücre ile eşleşen durumlarda sayfama resim getiren aşağıdaki gibi kodum var ama hücre değeri ile resim adı aynı olması gerekiyor.
İstediğim resmin adı hücre değerini içeriyorsa resim getirmesi
örnek;
hücre değeri: 140255
resim adı :140255 tkm
gibi durumlarda resim gelmesini istiyorum.
binlerce resim olduğu klasörden çalışıyorum. yardımcı olursanız çok memunun olurum.
Hücre ile eşleşen durumlarda sayfama resim getiren aşağıdaki gibi kodum var ama hücre değeri ile resim adı aynı olması gerekiyor.
İstediğim resmin adı hücre değerini içeriyorsa resim getirmesi
örnek;
hücre değeri: 140255
resim adı :140255 tkm
gibi durumlarda resim gelmesini istiyorum.
binlerce resim olduğu klasörden çalışıyorum. yardımcı olursanız çok memunun olurum.
Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim s1 As Worksheet
Dim s2 As Worksheet
Set s1 = Sheets("Şablon")
Set s2 = Sheets("Resim")
x = s1.Cells(Rows.Count, 2).End(xlUp).Row
s1.Range("a6:a" & x).Select
Selection.ClearContents
s1.Range("a2").Select
If Intersect(Target, Range("a6:a" & x)) Is Nothing Then Exit Sub
Cancel = True
Target.Font.Name = "Wingdings"
Target = IIf(Target = "ü", "", "ü")
s1.Cells(2, 3).ClearContents
s1.Cells(2, 3) = Left(Cells(Target.Row, 2), 5)
s1.Cells(2, 4) = Cells(Target.Row, 3)
s1.Cells(2, 5) = Cells(Target.Row, 5)
s2.Select
sat1 = 2
sat2 = 55
sut1 = "a"
sut2 = "k"
Set Adres = s2.Range(s2.Cells(sat1, sut1), s2.Cells(sat2, sut2))
Set Adres2 = s2.Cells(sat2, sut2)
Dim yer
Dim Picture As Object
For Each Picture In ActiveSheet.Shapes
If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
Picture.Delete
End If
Next Picture
son = 6
ReDim uzanti(son)
uzanti(1) = ".jpg"
uzanti(2) = ".JPG"
uzanti(3) = ".bmp"
uzanti(4) = ".BMP"
uzanti(5) = ".gif"
uzanti(6) = ".GİF"
klasor = "D:\Data\URUN_YONETIMI\Siparisler ve Üretim Kartelaları\DIŞ GİYİM\"
isim = s1.Cells(2, "c").Value
For j = 1 To son
Dosya = klasor & isim & uzanti(j)
If CreateObject("Scripting.FileSystemObject").FileExists(klasor & isim & uzanti(j)) = True Then
ActiveSheet.Shapes.AddPicture Dosya, msoFalse, msoCTrue, Adres.Left + 2, Adres.Top + 2, Adres.Width - 4, Adres.Height - 4
ActiveSheet.Cells(2, "c").Select
Exit For
End If
Next
End Sub