Soru Resim 1 e çift tıklayınca resim büyüsün tekrar tıklayınca küçülsün

Katılım
25 Temmuz 2011
Mesajlar
83
Excel Vers. ve Dili
2019
Altın Üyelik Bitiş Tarihi
24-03-2023
Merhaba Üstadlarım;

Başlıktaki işlemi aşağıdaki makrolarla buton yardımı ile yapıyorum ama kullanıcının işini kolaylaştırmak amacıyla çift tıklayınca Sub Resmi_buyut(),aynı resme tekrar çift tıklayınca Sub Resmi_kucult() makrosunu çalıştırabilir mi?

Yada bu şekilde olmuyorsa makrolarım çift tıklama komutuna ayarlanabilir mi?
Kod:
Sub Resmi_buyut()

  Sheets("SİPARİŞ SAYFASI").Select
    Application.DisplayFullScreen = True
    Application.DisplayFormulaBar = False
    Application.DisplayFormulaBar = False
        With ActiveWindow
            .DisplayHorizontalScrollBar = False
            .DisplayVerticalScrollBar = False
            .DisplayWorkbookTabs = False
        End With
 Rows("2:2").RowHeight = 270
On Error Resume Next
strPic = "Resim 1"
Set shp = ActiveSheet.Shapes(strPic)

With Shape

       shp.ShapeRange.LockAspectRatio = msoTrue
       shp.Left = ActiveSheet.Range("A1").Left
       shp.Top = ActiveSheet.Range("A1").Top
       shp.Width = ActiveSheet.Range("A1:E2").Width
       shp.Height = ActiveSheet.Range("A1:E2").Height
End With

End Sub


Sub Resmi_kucult()
Rows("2:2").RowHeight = 113.25

On Error Resume Next
strPic = "Resim 1"
Set shp = ActiveSheet.Shapes(strPic)

With Shape

       shp.ShapeRange.LockAspectRatio = msoTrue
       shp.Left = ActiveSheet.Range("A1").Left
       shp.Top = ActiveSheet.Range("A1").Top
       shp.Width = ActiveSheet.Range("A1:C2").Width
       shp.Height = ActiveSheet.Range("A1:C2").Height
End With


End Sub
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Geçmişte forumda hazırladığım bir Excel dosyasını paylaşayım. Faydası olacaktır.
 

Ekli dosyalar

Katılım
25 Temmuz 2011
Mesajlar
83
Excel Vers. ve Dili
2019
Altın Üyelik Bitiş Tarihi
24-03-2023
Geçmişte forumda hazırladığım bir Excel dosyasını paylaşayım. Faydası olacaktır.
Hocam şimdi anladım,resimlere makro atamışsınız.Ama benim dosyamdaki resimler değişken,ürün kodları değiştikçe dosyadan tekrar resim1 olarak çağırıyor.
 
Katılım
25 Temmuz 2011
Mesajlar
83
Excel Vers. ve Dili
2019
Altın Üyelik Bitiş Tarihi
24-03-2023
Başka fikri olan bir üstadım da var mıdır acaba?Yeni fikir almak her zaman iyidir
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Yukarıdaki kodlarınıza aşağıdaki koyu renkli ilaveyi yaparak deneyin. Tabii benim eklediğim dosyadaki buyut isimli makroyuda bir module kopyalamayı
unutmayın.

shp.onaction= = "buyut"

Kod:
With Shape

       shp.ShapeRange.LockAspectRatio = msoTrue
       shp.Left = ActiveSheet.Range("A1").Left
       shp.Top = ActiveSheet.Range("A1").Top
       shp.Width = ActiveSheet.Range("A1:C2").Width
       shp.Height = ActiveSheet.Range("A1:C2").Height
       shp.onaction= = "buyut"
End With
 

mrtank50

Altın Üye
Katılım
10 Haziran 2018
Mesajlar
25
Excel Vers. ve Dili
Excel 2021 LTSC Professional Plus 64 bit
Altın Üyelik Bitiş Tarihi
10-03-2027
Geçmişte forumda hazırladığım bir Excel dosyasını paylaşayım. Faydası olacaktır.
Levent bey merhaba
Burdaki sola dayama kodunu sağ'a dayama şeklinde nasıl değiştirebilirim.
Sanırım o kod bu ActiveSheet.Shapes(Application.Caller).TopLeftCell.Activate
 
Üst