Resim Ekleme

[cevatyildiz]

Merhaba,

aşağıdaki kodda sadece ilgili hücreye resmi ekliyor, ilgili hücre yerine kod içinde benim belirleyeceğim bir alan resimi ekletmek için nasıl bir değişiklik yapmam gerekiyor. Bu arada resmin orjianal en boy oranının korunmasını istiyorum.

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

Yardımlarınız için teşekkürler

 

[Emir Hüseyin Çoban]

Activecell kısımlarını range("a1") şeklinde değiştirerek deneyin.

.

 

[cevatyildiz]

tek bir hücre içine konumlandırıyor yine. En boy oranını korumak ve istediğim alan içerisinde gösterebilmek istiyorum

 

[Emir Hüseyin Çoban]

Görmek istediğiniz hücre aralığı nedir.

 

[cevatyildiz]

Fark etmez, her bir butonun üzerindeki bir dikdörtgenin içine sığdırmak istiyorum, kolay yolu her bir butona farklı kod yazılabilir diye düşünmüştüm

 

[Emir Hüseyin Çoban]

. . .

Tablonuzun örneğini yükleyiniz. Üzerinde inceleyelim.

. . .

 

[cevatyildiz]

Ek te örnek dosyayı görebilirsiniz. Butonların üstündeki alanlara denk gelecek şekilde resimleri yerleştirmek istiyorum.

İkinci sayfada ise resimi yatay olarak ilgili alana sığdırmak istiyorum. Yardımlarınız için teşekkürler Hüseyin Bey

 

[Emir Hüseyin Çoban]

. . .

Her buton için ayrı kod yazılabilir dediğiniz gibi.

Buton tıklandığında hücre aralığını seçtirsek sorun olur mu.

. . .

 

[cevatyildiz]

İşimizi gördüğü takdirde kötünün, iyisi bile güzel bir çözümdür Hüseyin Bey

Her butona ayrı kodla beraber yapsak daha iyi olmaz mı? Bu şekilde kullanıcı hücreleri seçmek zorunda kalmaz.

İkinci sayfadaki yatay resimi de yapabilecek miyiz?

 

[Emir Hüseyin Çoban]

. . .

Şu kodları deneyiniz.

[B]Sub RESİM_1A()[/B]
    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 = Range("B2:O17").Height
        .Width = Range("B2:O17").Width
        .Top = Range("B2:O17").Top
        .Left = Range("B2:O17").Left
        .Placement = xlMoveAndSize
    End With
    
    Set pic = Nothing
    
End Sub

Sub [B]YATAY[/B]()
    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
        .ShapeRange.IncrementRotation 180
        .Height = Range("B68:AE119").Height
        .Width = Range("B68:AE119").Width
        .Top = Range("B68:AE119").Top
        .Left = Range("B68:AE119").Left
        .Placement = xlMoveAndSize
    End With
    
    Set pic = Nothing
    
End Sub

. . .

 

[cevatyildiz]

Hüseyin Bey gayet güzel oldu,
yatay için rotation 270 yaptım ama height, width top left ile ilgili sıkıntım var. bu değerleri nasıl düşünmem gerekiyor. Çok absürd bir görüntü oldu

 

[Emir Hüseyin Çoban]

. . .

180 derece ile olmuyor mu.

Hücre genişliğiniz sabit sanırım.
Onları hücreden değilde elle girin. Deneme yanılma yönetimi ile en uygun ölçüyü bulmaya çalışın.

Küçük bir ekran görüntüsü eklerseniz inceleyelim.

. . .

 

[cevatyildiz]

kodlarla beraber ekledim, 180 derece ters donduruyor, ben yatay olarak kullanmak istiyorum