Resmi hücre içine otomatik sığdırma.

iozturk2016 · 21 Temmuz 2018

Merhabalar işim sebebiyle yaklaşık 500'den fazla resim ile uğraşacağım. İstediğim ise resmi eklediğimde otomatik olarak eklediğim hücrenin boyutunu alması. Forumu araştırdığımda birkaç adet makro buldum.Denediğimde bazıları hücre çizgisinin üzerine denk geliyor ve çıktı alındığında hücre kenarlıkları gözükmüyordu. Bazılarında ise Excel versiyonu sanırım uyuşmadığından resmi eklediğimde hücre çizgilerine sıfır oturmuyor. Kısacası istediğim makro, eklediğim resmin hem hücrenin boyutuna göre kendini ayarlaması hem de hücre ile resim arasında mm'lik boşluk olmadığı gibi hücre çizgisine de taşmaması. Vakit ayırıp okuduğunuz ve edeceğiniz yardımlarınız için şimdiden teşekkür ederim.

Excel 2016-Türkçe

Ömer BARAN · 21 Temmuz 2018

Merhaba.

Konu açmadan önce forumda ARAMA yapmanızın yerinde olacağını hatırlatmalıyım.

Aşağıdaki konu sayfasındaki kodların (4 numaralı cevap), istediğiniz işlemi yapıyor olması gerekir.
https://www.excel.web.tr/threads/iki-ayri-huecreye-resim-ekleme.136188/
.

iozturk2016 · 21 Temmuz 2018

Ömer BARAN' Alıntı:
Merhaba.

Konu açmadan önce forumda ARAMA yapmanızın yerinde olacağını hatırlatmalıyım.

Aşağıdaki konu sayfasındaki kodların (4 numaralı cevap), istediğiniz işlemi yapıyor olması gerekir.
https://www.excel.web.tr/threads/iki-ayri-huecreye-resim-ekleme.136188/
.

Öncelikle cevabınız için çok teşekkür ederim Ömer Bey. İlk başta da belirttiğim gibi forumda bir süre arama yaptım. Vermiş olduğunuz konudaki kodları da denedim. Ancak konuda da belirttiğim gibi kenarlık koyduğum zaman iyice belirginleşiyor. Resim sol ve üst kısımdan hücre çizgisinin üstüne çıkıyor. Ancak sağ ve alt kısımdan böyle bir problem yaşamıyorum Ömer Bey. Aşağıya detaylı resim koydum. Tüm resimlerde bu problemi yaşıyorum. Sağ ve alt kenarlık belirgin iken sol ve üst kenarlık gözükmüyor bile. Sorun ne ile alakalı olabilir hiçbir fikrim yok. Kod harici girinti ile ilgili mi onu da bilmiyorum. Sonuç olarak yardımınızı bekliyorum.

Ömer BARAN · 21 Temmuz 2018

Deneme yanılma ile bakmak lazım bence.
Kenarlık standart olarak var olacaksa; resim .Left, .Top ve .Width, .Heght ayarlarını belli miktarda değiştirerek bulmayı deneyin derim ben.
Genişlik ve yüksekliği azaltıp, sol ve üste hücre köşesine göre aynı miktarda boşluk bırakmayı deneyin,
ya da picture nesnesi ekleyip (kenarlık ve boyutlandırmayı bu nesne için tamamlayıp, resimi bu nesne içinde görüntümetebilirsiniz.
Bu kadar ince ayar şart diyorsunuz.
Belki de hücreye kenarlık uygulamayıp, resime çerçeve uygulamayı denemelisiniz.

Haluk · 21 Temmuz 2018

Excel VBA'de hücrelere yerleştirilen nesnelerin "TopLeftCell" özelliği vardır.

Buradan hareketle; VBA koduyla adresi belli bir hücreye kodla resim yerleştirirken, VBA bu özelliğe benzer bir özellik göz önüne alır ve resmin sol-üst köşesini hücrenin sol-üst köşesine milimetrik olarak getirir. Bunu yaparken, hücrede kenarlık varsa; kenarlık dahil olmak üzere sol-üst köşeyi esas aldığında, sizin belirttiğiniz gibi resim sol ve üst kenardan oturur, sağ ve alt kenarlarında bir miktar açıklık kalabilir.

.

iozturk2016 · 21 Temmuz 2018

Ömer BARAN' Alıntı:
Deneme yanılma ile bakmak lazım bence.
Kenarlık standart olarak var olacaksa; resim .Left, .Top ve .Width, .Heght ayarlarını belli miktarda değiştirerek bulmayı deneyin derim ben.
Genişlik ve yüksekliği azaltıp, sol ve üste hücre köşesine göre aynı miktarda boşluk bırakmayı deneyin,
ya da picture nesnesi ekleyip (kenarlık ve boyutlandırmayı bu nesne için tamamlayıp, resimi bu nesne içinde görüntümetebilirsiniz.
Bu kadar ince ayar şart diyorsunuz.
Belki de hücreye kenarlık uygulamayıp, resime çerçeve uygulamayı denemelisiniz.

Haluk' Alıntı:
Excel VBA'de hücrelere yerleştirilen nesnelerin "TopLeftCell" özelliği vardır.

Buradan hareketle; VBA koduyla adresi belli bir hücreye kodla resim yerleştirirken, VBA bu özelliğe benzer bir özellik göz önüne alır ve resmin sol-üst köşesini hücrenin sol-üst köşesine milimetrik olarak getirir. Bunu yaparken, hücrede kenarlık varsa; kenarlık dahil olmak üzere sol-üst köşeyi esas aldığında, sizin belirttiğiniz gibi resim sol ve üst kenardan oturur, sağ ve alt kenarlarında bir miktar açıklık kalabilir.

.

Cevaplarınız için teşekkür ederim. Excel bilmediğim bi platformdu fakat yapmam gereken iş sebebiyle araştırma durumunda kaldım. Bu siteyi keşfettim ve gerçekten Excel ile neler yapıldığını gördükçe hayretler içerisinde kaldım. İşimi bitirdikten sonra ilk yapacağım Excel'i tüm detaylarıyla öğrenmek. Şu zamana kadar yaptığım işleri farklı platformlarda çıkarmaya çalışıyordum. Forumu gezdikçe aslında hepsini sadece Excel ile yapabileceğimi farkettim. Sorunuma gelirsek Ömer Bey'in vermiş olduğu konudaki kodun neresinde değişiklik yapmalıyım ki sol ve üstten mm'lik olarak resim içeri girip yerine otursun? Top ve Left kısımlarındaki ActiveCell kısmını silip değer mi yazacağım acaba?

Kod:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
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 = Target.Offset(0, 0).MergeArea.Height
.Width = Target.Offset(0, 0).MergeArea.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With
Set pic = Nothing
Range("F1").Select
End Sub

mahmut011 · 21 Temmuz 2018

Bu şekilde dener misiniz. Resmin gerçek en-boy oranı bozulmaması için
.ShapeRange.LockAspectRatio = msoTrue yaptım, en boy oranı bozulsa da hücreyi tam doldurması istenirse False yapılabilir.

Kod:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
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 = msoTrue
.Height = Target.Offset(0, 0).MergeArea.Height
If .Width > Target.Offset(0, 0).MergeArea.Width Then
.Width = Target.Offset(0, 0).MergeArea.Width
End If
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With
Set pic = Nothing
Range("F1").Select
End Sub

Ömer BARAN · 21 Temmuz 2018

.Top = ActiveCell.Top ve
.Left = ActiveCell.Left
satırlarının sonuna + 0.1 gibi (ondalık ayracı olarak NOKTA) değer eklemeyi deneyin.
Üst ve sol kısım için tamam diye düşündüğünüzde ise;
.Height = Target.Offset(0, 0).MergeArea.Height ve
.Width......
satırlarında benzer şekilde EKSİ olarak ilave yapmayı deneyin.

iozturk2016 · 21 Temmuz 2018

Sorunum çözüldü. Ömer Bey'in tavsiye ettiği yöntemi kullandım ve herhangi bir problem kalmadı. Denediğim ve başarılı olan değerleri buraya paylaşıyorum. Aynı problemi yaşayan ve yaşayacak kişiler buradan alsın. Ömer Bey, Haluk Bey ve Mahmut Bey yardım etmek için ayırdığınız vakit için çok teşekkür ediyorum. Çok forumda üyeliğim var fakat şuana kadar yaşadığım bir problem hakkında en iyimser ve hızlı yaklaşımı sizden gördüm. Tekrar emekleriniz için teşekkür ediyorum.

Sorunu çözdüğüm değerler

Kod:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
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 = Target.Offset(0, 0).MergeArea.Height - 0.2
.Width = Target.Offset(0, 0).MergeArea.Width - 0.2
.Top = ActiveCell.Top + 0.2
.Left = ActiveCell.Left + 0.2
.Placement = xlMoveAndSize
End With
Set pic = Nothing
Range("F1").Select
End Sub

Ömer BARAN · 23 Temmuz 2018

Estağfurullah.

Başı sonu belli, net olarak açıklanmış soruların çözüme ulaşması çok zaman almaz.
Bilgi sahibi bir üye mutlaka, sonuca ulaşacak yolu açarak veya doğrudan çözümü vererek destek olacaktır.

Bu arada; soruları ekran görüntüsü yerine örnek belge üzerinden sormanızda yarar olduğunu haırlatmalıyım.
Örnek belge özellikleri ve örnek belge yükleme yöntemine ilişkin kısa açıklama cevabımın altındaki İMZA bölümünde var.

İyi çalışmalar dilerim.

mesutaygun70 · 21 Temmuz 2023

Kolay gelsin. Çok güzel bir konu ve cevap verilmiş ama dikey fotoğrafları, yatay olarak alıyor.
Ayrıca eklemek için klasör seçtiğimizde toplu fotoğraf ekleyebilirmiyiz (sonraki fotoğraf bir alt satıra gelecek şekilde)

Resmi hücre içine otomatik sığdırma.

iozturk2016

Ömer BARAN

Uzman

iozturk2016

Ömer BARAN

Uzman

Haluk

𐱅𐰇𐰼𐰚

iozturk2016

mahmut011

Altın Üye

Ömer BARAN

Uzman

iozturk2016

Ömer BARAN

Uzman

mesutaygun70