Resim boyutu değiştirme hk

[ersoyalan]

Merhaba,

Ekli dosyada resimleri tıkladığım zaman boyutları büyüyor fakat tekrar tıkladığımda eski boyutlarına gelmiyor.Eski boyutlarına gelebilmeleri için nasıl bir düzenleme yapmam gerekiyor.

Not : Sayfada hangi hücreye resim eklersem ekliyim tıkladığım zaman boyutlarının değişmesi gerekiyor.

Yardımcı olursanız sevinirim.


Syg,
E.ALAN

 

[Ferhat Pazarçevirdi]

Module3'teki tüm kdoları silerek, aşağıdaki kodları bu bölüme kopyalayınız.

Option Explicit
Sub buyut()
    Dim objShp As Shape
 
    Set objShp = ActiveSheet.Shapes(Application.Caller)
 
    With objShp
        If Len(.AlternativeText) = 0 Then
            .AlternativeText = .Height & ";" & .Width
        End If
    End With
 
    Call Buyuklugu_Kontrol_Et(objShp)
 
    Set objShp = Nothing
End Sub
[COLOR=darkgreen]'------------------------------------[/COLOR]
Sub Buyuklugu_Kontrol_Et(objShp As Shape)
 
    Dim vSpl As Variant
    Dim dblShpYuk As Double
    Dim dblShpGen As Double
    Dim i As Integer
 
    For Each vSpl In Split(objShp.AlternativeText, ";")
        i = i + 1
        If i = 1 Then dblShpYuk = CDbl(vSpl) Else dblShpGen = CDbl(vSpl)
    Next
    If objShp.Height = dblShpYuk Then
        objShp.Height = dblShpYuk * 3
        objShp.Width = dblShpGen * 3
    Else
        objShp.Height = dblShpYuk
        objShp.Width = dblShpGen
    End If
 
End Sub

 

[ersoyalan]

Ferhat hocam merhaba,

Verdiğiniz kod gayet güzel çalışıyor fakat şöyle bir sorun var.

Herhangi bir resmi tıkladığım zaman boyutu büyüyor fakat diğer resimler büyüyen resmin üzerinde gözüküyor diğer resimlerin gözükmemesi gerekiyor.Yardımcı olurmusunuz.

Ekli dosyayı incelemeniz mümkünmüdür.

E.ALAN

 

[Ferhat Pazarçevirdi]

Tm olarak ne demek istediğiniz anlamadım ama kodların belirttiğim kısmını aşağıdaki gibi değiştirirseniz, büyüyen resmi önde göreceksiniz. Küçülen resim ise arkaya düşer ... Ama eğer kastettiğiniz şey buysa tabi ...

    If objShp.Height = dblShpYuk Then
        objShp.Height = dblShpYuk * 3
        objShp.Width = dblShpGen * 3
[COLOR=red]        objShp.ZOrder msoBringToFront[/COLOR]
    Else
        objShp.Height = dblShpYuk
        objShp.Width = dblShpGen
[COLOR=red]        objShp.ZOrder msoSendBackward[/COLOR]
    End If

 

[ersoyalan]

Ferhat hocam bi kod bukadarmı güzel yazılabilir , nedemek istediğiniz tam anlıyamadım diyorsunuz fakat cuk diye kodları oturtuyorsunuz.

Yardımlarınız için çok teşekkürederim.Tam istediğim oldu.

Syg,
E.ALAN

 

[tahsinanarat]

Sn. ersoyalan
-Resim ekleme proğrmına saadece gif uzantılı resimlermi yoksa jpg uzantılı resimlerde eklenebiliyormu, örnek dosyanızda ben hiç bir resim ekleyemedim.
-Resim boyutunu değiştirme olayı *.jpg uzantılı dosyalar için de mümkün mü,