düşey ara, indis, kaçıncı ve resim bulma

[cimenerdal]

Merhabalar.
A sütununda isimler, B sütununda işyerlerinin kartvizit resimleri var.
c sütununa işyeri ismi yazınca D sütununa kartvizit resmi gelsin istiyorum.

Bi çok video izledim. Yaptıklarını yaptım ama beceremedim.
Yardımlarınızz için şimdiden teşekkürler

 

[1Al2Ver]

Merhaba,

Ad Tanımla ile ResimAl ve ResimAl2 formülleri kullanılmıştır,

Ad Tanımlamaları inceleyiniz.

"RESİMLER" sayfasında "C1" den isim seçin yada,

"SÜZ" sayfasında "A1"den isim seçin,

Kolay gelsin...

İndir Resim

Dosyayı indir Resim

dosya.co

 

[cimenerdal]

Teşekkürler

 

[cimenerdal]

Merhaba,

Ad Tanımla ile ResimAl ve ResimAl2 formülleri kullanılmıştır,

Ad Tanımlamaları inceleyiniz.

"RESİMLER" sayfasında "C1" den isim seçin yada,

"SÜZ" sayfasında "A1"den isim seçin,

Kolay gelsin...Ekli dosyayı görüntüle 228526

İndir Resim

Dosyayı indir Resim

dosya.co

gönderdiğiniz dosyaya kartvizit resimlerini ekledim
formülü daha çok satırı alacak şekilde büyülttüm.
ama ilginç bişey oldu.
resimler ters gözüküyor, yansımalı gibi oldu. yani resimdeki yazılar tersten görünüyor.
bazı resimler kesilmiş geliyor. hepsinin aynı boyutta mı olmas gerekli?

 

[1Al2Ver]

Merhaba,

Öneri ;

Dosyanızın bu haliyle bir örneğini, dosya yükleme sitelerinden birine yükleyip verilen linki burada paylaşın,

yada,

Altın Üye olun ve foruma sınırsız dosya yükleme-indirme vb. yetkisi kazanın,

Elbette tercih sizin,

Teşekkür ederim.

 

[cimenerdal]

Merhaba,

Öneri ;

Dosyanızın bu haliyle bir örneğini, dosya yükleme sitelerinden birine yükleyip verilen linki burada paylaşın,

yada,

Altın Üye olun ve foruma sınırsız dosya yükleme-indirme vb. yetkisi kazanın,

Elbette tercih sizin,

Teşekkür ederim.

örnek dosyam

 

[1Al2Ver]

Merhaba,

Eklenen dosyada tarafımdan bir işlem ( deneme vb ) yapılamıyor,

#4 no.lu mesajda bahsi geçen "resimler ters gözüküyor, yansımalı gibi oldu. yani resimdeki yazılar tersten görünüyor." ifadeniz için şunu söyleye bilirim, örnek dosyanızda bir anormallik görülmüyor,

Resim boyutları farklı olduğu için "B" sütunundaki aralığa hepsi farklı boyutlarda geliyor,

Bence, üzerinde deneme yapılabilinen bir örnek dosya paylaşmanız çözüm almanızı kolaylaştıracaktır.

Teşekkür ederim.

 

[1Al2Ver]

Tekrar Merhaba,

Aşağıdaki kodu bir Modül'e kopyalayın,

"RESİMLER" sayfasında bir düğme oluşturun, modüldeki makroyu düğmeye atayın,

"RESİMLER" sayfası "B" sütununun enini-boyunu ayarlayın, resim ekleyeceğiniz hücreye (örneğin B2 tıklayın) sonra düğmeyi tıklayın,

"RESİMLER" sayfası "B" sütununa ekleyeceğiniz resimler için klasörden-dosyadan vb. eklenecek resimi seçin,

Seçilen resim, önceden seçtiğiniz hücreye (örneğin B2), tam olarak gelecektir.

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 Show = -1 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

On Error Resume Next

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

 

[cimenerdal]

Merhaba,

Eklenen dosyada tarafımdan bir işlem ( deneme vb ) yapılamıyor,

#4 no.lu mesajda bahsi geçen "resimler ters gözüküyor, yansımalı gibi oldu. yani resimdeki yazılar tersten görünüyor." ifadeniz için şunu söyleye bilirim, örnek dosyanızda bir anormallik görülmüyor,

Resim boyutları farklı olduğu için "B" sütunundaki aralığa hepsi farklı boyutlarda geliyor,

Bence, üzerinde deneme yapılabilinen bir örnek dosya paylaşmanız çözüm almanızı kolaylaştıracaktır.

Teşekkür ederim.

Özür dilerim. Dosyayı değiştirebilirsiniz

 

[cimenerdal]

Tekrar Merhaba,

Aşağıdaki kodu bir Modül'e kopyalayın,

"RESİMLER" sayfasında bir düğme oluşturun, modüldeki makroyu düğmeye atayın,

"RESİMLER" sayfası "B" sütununun enini-boyunu ayarlayın, resim ekleyeceğiniz hücreye (örneğin B2 tıklayın) sonra düğmeyi tıklayın,

"RESİMLER" sayfası "B" sütununa ekleyeceğiniz resimler için klasörden-dosyadan vb. eklenecek resimi seçin,

Seçilen resim, önceden seçtiğiniz hücreye (örneğin B2), tam olarak gelecektir.

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 Show = -1 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

On Error Resume Next

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

gönderdiğiniz kod hata veriyor.
hata verdiği satır şurası

("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _

 

[1Al2Ver]

Merhaba,

Kod satırını aşağıdaki gibi düzenler misiniz ?

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

Kolay gelsin.

 

[cimenerdal]

harikasınız. teşekkürler. süper oldu.

 

[cimenerdal]

Başka bir butonla eklediğim resimleri tek seferde silebilir miyim?