resim ekleme-büyütme.teklif formatı.

[bu12ak]

Arkadaşlar excelde resimli teklif formatı oluşturmaya çalışıyorum.
Örnekleri inceleyerek bişeyler yaptım.
Teklifler 15 sayfaya kadar çıktığı için her ürünün yanına da image nesnesi eklediğim için her sayfada 25 satır olsa 375 image oluyo. ben bunlara benim girdiğim gibi tek tek makromu yazcam .Örneğe göre başka fikir verebilecek varsa şimdiden teşekkürler.
Aşağıdaki gibi tek tek yazıyorum.

Private Sub Worksheet_Change(ByVal Target As Range)
'sayfadaki hücrelerde bir değişiklik olduğunda image1 nesnesine Resim çağırır
Image1.PictureSizeMode = fmPictureSizeModeZoom
Image1.Picture = LoadPicture(['TEKLİF'!b13])
Image1.PictureSizeMode = fmPictureSizeModeStretch
Image1.Width = 70
Image1.Height = 24

 

[Levent Menteşoğlu]

Teklif sayfasının kod sayfasına aşaüıdaki kodu kopyalayarak denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c:c]) Is Nothing Then Exit Sub
If Target <> "" Then
Dim nesne As Shape
For Each nesne In ActiveSheet.Shapes
If nesne.TopLeftCell.Address = Target.Previous.Address Then
yol = WorksheetFunction.Match(Target.Previous.Previous, ['Birim Fiyat L.'!b:b], 0)
say = nesne.OLEFormat.Object.Index
ActiveSheet.Shapes(say).OLEFormat.Object.Object.PictureSizeMode = fmPictureSizeModeStretch
ActiveSheet.Shapes(say).OLEFormat.Object.Object.Picture = LoadPicture(Sheets("Birim Fiyat L.").Cells(yol, "f"))
Exit For
End If
Next
End If
End Sub

 

[halit3]

Alternatif olsun
not:dosyanın hemen yanında (Resimler) klasörü olması lazım ve resimlerde bu klasörün içinde olmalı ve uzantıları (jpg) olmalı resim adları c sütünündaki isimler olmalı
resim adları yazan yere tıkladığınızda resim nesnesini ekliyor.

 

[bu12ak]

Cvp veren arkadaşlara çok teşekkür ederim.
Levent bey asıl sorun çözüldü resimler geliyor ben tek tek yazmadan.
Fakat resimlerin boyutu büyük açılıyo ve geri kapanmıyor.
Nereyi yanlış yapıyorum.
Yanlız sizin yazdığınızı mı yapıştırıcam yoksa boyut ayarlama kısmı için bişey mi eksik.

 

[bu12ak]

autosize true değil false olunca düzeldi.
Levent hocam teşekkür ederim.
Bide merak ettim.
Çift tıkla büyütme olayını bu genel formüle nasıl uygularız.
Teklif sayfası için düşünürsek. image ler yine ayrı ayrı burda.

Private Sub Worksheet_Change(ByVal Target As Range)
'sayfadaki hücrelerde bir değişiklik olduğunda image1 nesnesine Resim çağırır
Image1.PictureSizeMode = fmPictureSizeModeZoom
Image1.Picture = LoadPicture(['Birim Fiyat L.'!D4])

Image1.PictureSizeMode = fmPictureSizeModeStretch
Image1.Width = 150
Image1.Height = 45
End Sub

Private Sub Image1_Click()
Image1.PictureSizeMode = fmPictureSizeModeStretch
Image1.Picture = LoadPicture(['Birim Fiyat L.'!D4])
Image1.Width = 150
Image1.Height = 45
End Sub

Private Sub Image1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Image1.Width = 450
Image1.Height = 340
End Sub

 

[bu12ak]

Levent bey iyi günler. soru yağmuruna tuttum ama.
Teklif sayfasında resimleri seçtikten sonra c:c de parça adını silince resim kalıyor.
Onun içinde bi çözüm eklerseniz çok iyi olur.
Her seferinde boş resimli bişeymi seçmeliyim.

 

[bu12ak]

Son bişey daha
teklif sayfasını başka bi kitapda düşünürsek. 2 kitap açıkken seçilen parça adıyla birim fiyat vs geliyor. Fakat resim de makro hata veriyor. Bu çok önemli hocam .
Kod düzenleme olayını beceremediğimden sadece problem üretiyorum kusura bakmayın.

 

[bu12ak]

Arkadaşlar Levent Bey yok galiba, başka yardımcı olcabilecek vardır diye konuyu toparlıyorum.
- Resimler çift tıkla büyüsün. Ama tek tek her image için makro yazmıyim.
- Resim seçtikten sonra resim geliyor fakat hücreyi boşaltınca resim gitmiyor.
her seferinde boş bişey mi seçmeliyim.
- Teklif sayfasını başka kitaba taşıyıp, orda çalışınca formülle bağlantılı olan şeyler geliyor. resimler gelmiyor kod da hata oluyor.


Dosyanın son hali ektedir. Teşekkür ederim.

 

[bu12ak]

yardımcı olacabilecek yokmu.

 

[halit3]

yardımcı olacabilecek yokmu.

3 nolu mesaj hakkında hiç yorum yapmamışsınız.

Dosyanızı kontrol edin.

Not: Resimler klasörü dosyanı yanında olacak ve dosya uzantıları jpg formatında olmalı

uyarı teklif sayfasında işiniz bittiği zaman dosyanızın boyutu artmaması için resimleri sil düğmesine tıklayınız.

 

[bu12ak]

Şimdi anladım sizinkini pardon. Ben örnek olsun diye yolladığınızı düşündüm.
Fakat benim resimler ve birim fiyat listem ortak bilgisayarda bi yerde olucak.
teklif dosyasıda hazırlayan kişinin bilgisayarında olucak. Benim dosyanın son hali nerdeyse istediğim gibi oldu. Yanlış bişey seçtiğimde resim geliyor hücre boşaltılsada resim gitmiyo. bide başka biyerde olunca teklif sayfası onu çalıştıramadım.

 

[halit3]

Şimdi anladım sizinkini pardon. Ben örnek olsun diye yolladığınızı düşündüm.
Fakat benim resimler ve birim fiyat listem ortak bilgisayarda bi yerde olucak.
teklif dosyasıda hazırlayan kişinin bilgisayarında olucak. Benim dosyanın son hali nerdeyse istediğim gibi oldu. Yanlış bişey seçtiğimde resim geliyor hücre boşaltılsada resim gitmiyo. bide başka biyerde olunca teklif sayfası onu çalıştıramadım.

O zaman kodların içinde bulunan resimlerin dosya yolunu kendinize göre değiştirin.

Dosya_Yolu = ThisWorkbook.Path & "\Resimler\"

 

[bu12ak]

Kardeşim ben beceremedim. Dosya yolu bu \\server\DATA\ortak\resimler
Zaten 2 yerde dosya yolu değişcek galiba .
Dosya_Yolu = ThisWorkbook.Path & "\\server\DATA\ortak\resimler\"
nerde yanlış oluyor.

 

[halit3]

Kardeşim ben beceremedim. Dosya yolu bu \\server\DATA\ortak\resimler
Zaten 2 yerde dosya yolu değişcek galiba .
Dosya_Yolu = ThisWorkbook.Path & "\\server\DATA\ortak\resimler\"
nerde yanlış oluyor.

böyle deneyin.

Dosya_Yolu = "\\server\DATA\ortak\resimler\"

 

[bu12ak]

Eline sağlık hocam. Çok güzel oldu. Peki bu en üstteki image le , resmi yukarı taşı benim işime yaramıcak gibi. Kodun neresinde yazıyo, onları kaldırsam.
Resimleri sil diyince İmage nesnesi geri geliyoda kaldıramadım.

 

[halit3]

Eline sağlık hocam. Çok güzel oldu. Peki bu en üstteki image le , resmi yukarı taşı benim işime yaramıcak gibi. Kodun neresinde yazıyo, onları kaldırsam.
Resimleri sil diyince İmage nesnesi geri geliyoda kaldıramadım.

Kaldırdım.