Makro ile resim denetimi ekranına resim ekleme

[bebar]

Merhaba;

yapmak istediğim iş ile ilgili pek çok konu açılmış fakat henüz yeni yeni vba ile uğrastığım için pek başarılı olamadım.

Ekte bulunan dosyada e sütununda bulunan ürün kodlarıyla aynı olan resimleri buton ile resim denetimi ekranına getirmesini istiyorum. dosyam ektedir.

Yardımcı olursanız çok sevinirim.

 

[Tevfik_Kursun]

Dener misiniz lütfen?
Kolay gelsin

 

[bebar]

Teşşekür ederim ama maalesef çalışmıyor.

 

[Tevfik_Kursun]

E sütununda istediğiniz örneğin hizasındaki D sütunundaki hücreye 1 rakamını yazınız
kolay gelsin

 

[bebar]

Bahsettiğiniz şekilde denemesini yaptım, belki hedef klasör ismininde sorun vardır dedim aşağıdaki gibi değiştirdim

yine olmadı

klasor = ThisWorkbook.Path & "\C:\Users\marka09.IMZA\Desktop\ÜRÜN GRUPLARI\"

teşekkür ederim.

 

[Tevfik_Kursun]

klasor = "C:\Users\marka09.IMZA\Desktop\ÜRÜN GRUPLARI\"
Şeklinde değiştirerek dener misiniz?
Kolay gelsin

 

[bebar]

Oldu hocam teşekkür ederim. fakat filtre yaptığım zaman resimler gelmiyor ve gelen resimleri 536x763 boyutunda ve yeni bir resim seçerken bir öncekini silersek çok daha iyi olabilir.

Yardımlarınız ve ilginiz için çok teşekkür ederim.

 

[Tevfik_Kursun]

Merhaba,
Filtre ettiğinizde E2 hücresi bozuluyorsa gelmemesi normal. Bozulmuyor ve ürünün resmi varsa mutlaka gelir diye düşünüyorum.
Sanırım sizin resimler aynı boyda ve çözünürlükte değil. Bende bu aynı makro çok temiz çalışıyor. Yine de,

Sub Resim_Sil()
Dim Picture As Object
    For Each Picture In ActiveSheet.Shapes
	If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
	    Picture.Delete
	    Exit For
	End If
    Next Picture
End Sub

Sanırım bu kod işinizi görür. Aynı sayfada komut düğmesi koyup Call Resim_Sil deyip yukarıdaki kodu da modüle eklerseniz sorunsuz çalışır.
Kolay gelsin

 

[bebar]

Teşekkür ederim hocam

 

[Tevfik_Kursun]

Rica ederim,
iyi çalışmalar

 

[bebar]

Hocam merhaba yardımlarınız için teşekkür ederim çok faydası oldu fakat kod yapılarını yeni yeni öğrenmeye başlamam dolayı yazmış olduğunuz makroyu anlamakta güçlük çekiyorum.

en azından bilgi edinmek açısından makronun algoritmasını ve hangi komutu veya satırını ne amaçla yazdığınızı açıklarsanız çok memnun olurum. yazmış olduğunuz makro aşağıdaki gibidir.

Private Sub CommandButton6_Click()
sat1 = 2
sat2 = 38
sut1 = "M"
sut2 = "V"

Set Adres = Range(Cells(sat1, sut1), Cells(sat2, sut2))
Set Adres2 = 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
yer = Cells(Picture.BottomRightCell.Row, Picture.BottomRightCell.Column).Address

yer1 = Adres2.Address
If yer = yer1 Then
Picture.Delete
Exit For
End If
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 = "C:\Users\marka09.IMZA\Desktop\ÜRÜN GRUPLARI\"

isim = Cells(2, "E").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(5, "D").Select

Exit For

End If
Next
End Sub

teşekkür ederim

 

[bebar]

yardımcı olacak arkadaş yok mudur ??

 

[Tevfik_Kursun]

Merhaba,
Yanlış hatırlamıyorsam bu makro benim size gönderdiğim örnek dosyada kullanılmıştı ve Halit3 Hocam hazırlamıştı. Bu vesileyle kendilerine de teşekkürlerimi sunarım.

sat1 = 2
sat2 = 38
sut1 = "M"
sut2 = "V"

resmin ekrana getirildiği bölge (rakamları ve kolon harflerini değiştirerek resmin büyüklüğü değiştirilebilinir)

Picture.Delete

resmin ekrana geldiği yerde önceden resim varsa Excel'e onu sil denilen satır

uzanti(1) = ".jpg"
uzanti(2) = ".JPG"
uzanti(3) = ".bmp"
uzanti(4) = ".BMP"
uzanti(5) = ".gif"
uzanti(6) = ".GİF"

resmin uzantısı,

klasor = "C:\Users\marka09.IMZA\Desktop\ÜRÜN GRUPLARI\"

resmin alındığı klasörün adresi,

isim = Cells(2, "E").Value

resmin adının yazılı olduğu hücre,

ActiveSheet.Cells(5, "D").Select

Excel işini bitirdikten sonra imlecin gelip oturduğu hücre
Gerisi de Excel'e bunun resim olduğunu, alıp gelmesi ya da silmesinin söylendiği ifadeler.
Bunun tamamı bir kalıp, kullanacak kişi kalıbı bozmadan kullanmalı.
İyi çalışmalar

 

[bebar]

Teşekkür ederim

 

[Tevfik_Kursun]

Rica ederim.
İyi çalışmalar