• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

L

Leturc

Katılım
31 Temmuz 2008
Mesajlar
93
Excel Vers. ve Dili
2003
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
 

Ekli dosyalar

Leturc' Alıntı:
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
Genişletmek için tıkla ...

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

Buradaki dosyalar size bir fikir verebilir.

.
 
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
 
Hocalarım konu ile ilgili sıkıntım devam etmekte. Bir fikriniz var mıdır?
 
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
Genişletmek için tıkla ...

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?
 
cok tesekkurler benımde cok ısıme yaradı ..:) emın ol senın kadar mutlu oldum paylasım guzel :)
 
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..
 
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
Genişletmek için tıkla ...
 
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.
 
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 ?
 
mrtyzc' Alıntı:
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 ?
Genişletmek için tıkla ...


kod:

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
 
Bu kod da aynı hücreye ikinci defa resim ekleyince eskisini siliyor.

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")

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
 
Halit Bey yardımınız için çok teşekkür ediyorum tam istediğim gibi bir macro olmuş..
 
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.
 

Ekli dosyalar

denese' Alıntı:
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.
Genişletmek için tıkla ...

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


Not: Kodlar Halit3 Hoca'ya aittir.
 

Ekli dosyalar

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.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst