Resim ekleme ve otomatik olarak hücreye sığdırma

[Leturc]

Merhaba sayın üstadlar,

Bir excel çalışması üzerinde biraz fantezi kurarak yapmayı arzuladığım bir şey var. Başlıktan da aslında anlaşılabileceği gibi, belirli bir hücrenin içerisine "GÖZAT" tarzı bir düğme ekleyerek buradan seçeceğim resmi hücrenin içerisine otomatik olarak sığdırması. Ayrıca eğer mümkünse her defasında hücreleri kopyala - yapıştır yapmak yerine resim ekleyecek kutu kalmadıkça otomatik olarak altta yenisi açılsın. Esasen ilk bahsetmiş olduğum daha da önemli benim için.

Eğer yardımcı olabilirseniz müteşekkir olurum.

Saygılarımla,

Murat KORKMAZ

 

[Merhum İdris SERDAR]

Merhaba sayın üstadlar,

Bir excel çalışması üzerinde biraz fantezi kurarak yapmayı arzuladığım bir şey var. Başlıktan da aslında anlaşılabileceği gibi, belirli bir hücrenin içerisine "GÖZAT" tarzı bir düğme ekleyerek buradan seçeceğim resmi hücrenin içerisine otomatik olarak sığdırması. Ayrıca eğer mümkünse her defasında hücreleri kopyala - yapıştır yapmak yerine resim ekleyecek kutu kalmadıkça otomatik olarak altta yenisi açılsın. Esasen ilk bahsetmiş olduğum daha da önemli benim için.

Eğer yardımcı olabilirseniz müteşekkir olurum.

Saygılarımla,

Murat KORKMAZ

http://www.excel.web.tr/showthread.php?t=22790

Buradaki dosyalar size bir fikir verebilir.

.

 

[Leturc]

daha önce inceleme fırsatım olmuştu ancak burada sabit bir kaynaktan çekiyor resimleri ancak ben belirlediğim yerden almak istiyorum.

teşekkürler

 

[Leturc]

Hocalarım konu ile ilgili sıkıntım devam etmekte. Bir fikriniz var mıdır?

 

[Leturc]

Ben buldum

Sub InsertPicture()
Dim sPicture As String, pic As Picture

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub

Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = ActiveCell.Height
.Width = ActiveCell.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With

Set pic = Nothing

End Sub

Ancak resmin eklendiği hücrenin bir üstüne açıklama eklemek isterim. A2'de resim A1'de açıklama şeklinde ancak bu açıklamayı resim seçildikten sonra gelecek kutucuğa yazabilir miyim?

 

[cetin1254]

cok tesekkurler benımde cok ısıme yaradı .. emın ol senın kadar mutlu oldum paylasım guzel

 

[cetin1254]

ama ben bırsey daha ısıtıyorum tabı mumkunse fıltre yaptıgımda o sutundakı degerlerle bırlıkte satırda kalmasını ıstıyorum ama fıltre yaptıgımda urun kodları ıstedıgım sıraya gırıyor ama satırdakı resımler degısmıyor sabıtler onlarıda yan hucrelerdekı degrler gıbı fıltreleme yaptıgımda bırlıkte hareket ederek rapor alabılırmıyım anlatabıldım umarım tesekkurler..

 

[Leturc]

Merhaba ustadlar;

yukaridaki kod ile ilgili bir sorunum var yardimci olabilir misiniz?

Bu kodu ben Excel 2007 surumunde sorunsuz bir bicimde calistiriyorum. Ancak 2003 surumunde hata veriyor. Hatayi duzeltmek icin "False" satirinin tirnak isaretlerini kaldiriyorum ve sorun duzeliyor ancak bu defa 2007'de hata veriyor.

Cozumu ile ilgili bir fikriniz var mi?

Sub InsertPicture()
Dim sPicture As String, pic As Picture

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub (Tirnak isaretleri ile 2007'de sorunsuz calisiyor 2003'de calismiyor. Tirnaklari kaldirirsam bu defa da tam tersi oluyor)

Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = ActiveCell.Height
.Width = ActiveCell.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With

Set pic = Nothing

End Sub

 

[bofarchi]

teşekkürler

Teşekkür ederim. Elinize sağlık.

İki konuda sorum olacak;
1. Resmi "merge cells" için uygulayabilir miyiz?
2. Butona basılınca seçili hücreye resim ekliyor. sabit bir hüsreye eklemesini sağlayabilir miyiz?

Şimdiden teşekkürler.

 

[mrtyzc]

buradaki kodlar sadece bir hücreye fotoğrafı sığdırmakta. aceba seçim yaptığım hücreye sığdırması mümkün değil mi ? yada 3-5 hücre birleştirip seçtiğimde o gurup hücrenin içine sığdırması mümkün değil mi ?

 

[halit3]

buradaki kodlar sadece bir hücreye fotoğrafı sığdırmakta. aceba seçim yaptığım hücreye sığdırması mümkün değil mi ? yada 3-5 hücre birleştirip seçtiğimde o gurup hücrenin içine sığdırması mümkün değil mi ?

kod:

Sub InsertPicture()
Dim sPicture As String, pic As Picture

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")


[COLOR="Red"]If Val(Len(sPicture)) = 0 Then Exit Sub[/COLOR]

Adres = ActiveWindow.RangeSelection.Address

Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic

.ShapeRange.LockAspectRatio = msoFalse
.Height = Range(Adres).Height - 4
.Width = Range(Adres).Width - 4
.Top = Range(Adres).Top + 2
.Left = Range(Adres).Left + 2
.Placement = xlMoveAndSize
End With

Set pic = Nothing

End Sub

 

[halit3]

Bu kod da aynı hücreye ikinci defa resim ekleyince eskisini siliyor.

Sub InsertPicture()
Dim sPicture As String, pic As Picture

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If Val(Len(sPicture)) = 0 Then Exit Sub

Adres = ActiveWindow.RangeSelection.Address

Dim Picture As Object
For Each Picture In ActiveSheet.Shapes

If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
yer1 = Picture.TopLeftCell.Address
yer2 = (Picture.TopLeftCell.Address & ":" & Picture.BottomRightCell.Address)
If yer1 = Adres Or yer2 = Adres Then
Picture.Delete
Exit For
End If
End If
Next Picture

Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic

.ShapeRange.LockAspectRatio = msoFalse
.Height = Range(Adres).Height - 4
.Width = Range(Adres).Width - 4
.Top = Range(Adres).Top + 2
.Left = Range(Adres).Left + 2
.Placement = xlMoveAndSize
End With

Set pic = Nothing

End Sub

 

[mrtyzc]

Halit Bey yardımınız için çok teşekkür ediyorum tam istediğim gibi bir macro olmuş..

 

[canbey6161]

Çoklu hücre seçerek

başka konuda takip

 

[canbey6161]

Emeğinize sağlık

 

[denese]

Çok teşekkürler Sayın halit3, emeğinize sağlık.

 

[halit3]

Çok teşekkürler Sayın halit3, emeğinize sağlık.

Teşekkürler iyi çalışmalar

 

[denese]

Merhaba,

Buton yardımıyla fotoğraf ekle dediğimde gözat penceresi açılıyor, ancak fotoğrafı eklemeden iptal deyip çıkmak istediğimde kod hata veriyor.

Bunu nasıl düzeltebilirim?

Dosya ektedir.

Dosya ve hata koduna buradan da ulaşabilirsiniz.

 

[BedriA]

Merhaba,

Buton yardımıyla fotoğraf ekle dediğimde gözat penceresi açılıyor, ancak fotoğrafı eklemeden iptal deyip çıkmak istediğimde kod hata veriyor.

Bunu nasıl düzeltebilirim?

Dosya ektedir.

Dosya ve hata koduna buradan da ulaşabilirsiniz.

Sayfaya bir Image nesnesi ekledim.
Hata vermiyor artık.
Ekteki dosyayı inceleyiniz.


Not: Kodlar Halit3 Hoca'ya aittir.

 

[denese]

Merhaba,

Sn. Halit3' e ait olan kod; fotoğrafı çalışma sayfasında seçili olan hücreye ekliyor. Bu kod ayrıca fotoğrafı hücrenin her iki yanına yaslayarak, yani hücre içine yerleştirerek ekliyor. Benim istediğim kodların mevcut yapısını bozmadan ilgili hatayı düzeltebilmek.