Soru Makro İle Resim Değiştirme

Rizelli3 · 26 Ocak 2021

Merhabalar,

Elimde 400 sayfalık bir dosya var ve logoları değiştirilmesi gerekiyor mevcut bir şablon oluşturmak istiyorum. 4 ayrı logo var dosyayı hazırladıktan sonra logoları değiştirmem gerekebiliyor logolara ad tanımlayarak aşağıdaki formül ile değiştirebiliyorum ancak Excel inanılmaz kasıyor 400 sayfa 2'şer logodan 800 logo ediyor nereye tıklasam 30 saniye kasıyor bunu makro ile daha kolay bir şekilde yapma imkanım var mıdır. Şimdiden yardımlarınız için teşekkür ediyorum. Sağlıklı günler.

=İNDİS(LOGO!$E$2:$E$4;KAÇINCI(VERİ!$G$4;LOGO!$D$2:$D$4;0))

mancubus · 26 Ocak 2021

Veri doğrulama ile bir deneyin.

Picture Lookup in Excel using Named Ranges

Learn how to use Named Ranges to do a Picture Lookup in Excel. This is a cool excel dashboard trick where pictures update dynamically based on selections

trumpexcel.com

açıklamaların altındaki Download butonu ile örnek dosyayı indirmek mümkün.

Rizelli3 · 26 Ocak 2021

mancubus' Alıntı:
Veri doğrulama ile bir deneyin.

Picture Lookup in Excel using Named Ranges

Learn how to use Named Ranges to do a Picture Lookup in Excel. This is a cool excel dashboard trick where pictures update dynamically based on selections

trumpexcel.com

açıklamaların altındaki Download butonu ile örnek dosyayı indirmek mümkün.

Desteğiniz için teşekkür ederim ancak kullanmış olduğum yöntem aynısı inanılmaz kasıyor sayfa sayısı ve logo sayısı fazla olduğu için 400 sayfada 2 şer tane logo var.

mancubus · 27 Ocak 2021

rica ederim.

işlem hakkında biraz detay verin.

bir defaya mahsus bir çalışma mı olacak? 800 resim değiştirilecek ve dosyada resimlerle ilgili işlem bitecek?
bu takdirde beklenebilir

sürekli veri değişecek te ona göre resim de mi değişecek.

ancak ne yapılırsa yapılsın 800 tane resim nesnesi ile çalışmak çok zahmetli olacaktır.

400 sayfalık dosya, 400 adet personel veya müşteri veya öğrenci veya ürün vb bilgileri içeren bir dosya gibi göründü bana.
bir yere gönderilmiyor ise resimsiz tutup raporlama sunum vb esnasında resim eklemek uygun olabilir.
excel'deki verileri 400 tablo olarak access'e taşımak ta bir çözüm olabilir.

Rizelli3 · 27 Ocak 2021

mancubus' Alıntı:
rica ederim.

işlem hakkında biraz detay verin.

bir defaya mahsus bir çalışma mı olacak? 800 resim değiştirilecek ve dosyada resimlerle ilgili işlem bitecek?
bu takdirde beklenebilir

sürekli veri değişecek te ona göre resim de mi değişecek.

ancak ne yapılırsa yapılsın 800 tane resim nesnesi ile çalışmak çok zahmetli olacaktır.

400 sayfalık dosya, 400 adet personel veya müşteri veya öğrenci veya ürün vb bilgileri içeren bir dosya gibi göründü bana.
bir yere gönderilmiyor ise resimsiz tutup raporlama sunum vb esnasında resim eklemek uygun olabilir.
excel'deki verileri 400 tablo olarak access'e taşımak ta bir çözüm olabilir.

Yetersiz bilgi için kusura bakmayın hocam.

A firması bir rapor istiyor yaklaşık 400 sayfa o firmaya ait 2 logo logo oluyor dosyada aynı raporu b firması da istiyor b firmasına ait 2 farklı logoyu değiştirmem gerekiyor yapmak istediğim a firmasına hazırladığım dosyayı kopyalayıp logolarını değiştirmek içeriğinde değişiklikler yapacağım için veri doğrulama ile yaptığımda her hücreye tıklamamda 20-30 saniye donuyor dosya. Teşekkürler iyi çalışmalar.

Korhan Ayhan · 27 Ocak 2021

Küçük bir örnek dosya paylaşır mısınız?

Rizelli3 · 27 Ocak 2021

Korhan Ayhan' Alıntı:
Küçük bir örnek dosya paylaşır mısınız?

Merhabalar,

Örnek dosya linke yüklenmiştir. Kendi yapmış olduğum şekilde hazırladım örnek dosyayı sayfa sayısı çok olunca malesef bu şekilde inanılmaz kasıyor.

Buradan indirebilirsiniz. Şimdiden yardımınız için teşekkürler.

İyi çalışmalar.

Korhan Ayhan · 28 Ocak 2021

Logoların nasıl değişmesini istiyorsunuz?

Korhan Ayhan · 28 Ocak 2021

LOGO sayfasında K1 ve K2 hücrelerine sayfalara kopyalanacak resim adlarını yazdıktan sonra aşağıdaki kodu denedim. Yaklaşık 2 saniyede logoları değiştiriyor.

C++:

Option Explicit

Sub Logolari_Guncelle()
    Dim S1 As Worksheet, Sh As Worksheet, Logo As Shape, Zaman As Double
  
    Zaman = Timer
  
    Application.ScreenUpdating = False
  
    Set S1 = Sheets("LOGO")
  
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> "LOGO" Then
            For Each Logo In Sh.Shapes
                If Logo.Type = msoPicture Then Logo.Delete
            Next
          
            S1.Shapes(S1.Range("K1").Text).Copy
            Sh.Select
            Sh.Range("B2").Select
            Sh.Paste
            S1.Shapes(S1.Range("K2").Text).Copy
            Sh.Range("G2").Select
            Sh.Paste
            Sh.Range("A1").Select
        End If
    Next
  
    S1.Select
  
    Set S1 = Nothing
  
    Application.ScreenUpdating = True
  
    MsgBox "Logo güncelleme işlemi tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

Rizelli3 · 28 Ocak 2021

Korhan Ayhan' Alıntı:

LOGO sayfasında K1 ve K2 hücrelerine sayfalara kopyalanacak resim adlarını yazdıktan sonra aşağıdaki kodu denedim. Yaklaşık 2 saniyede logoları değiştiriyor.

C++:

Option Explicit

Sub Logolari_Guncelle()
    Dim S1 As Worksheet, Sh As Worksheet, Logo As Shape, Zaman As Double
 
    Zaman = Timer
 
    Application.ScreenUpdating = False
 
    Set S1 = Sheets("LOGO")
 
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> "LOGO" Then
            For Each Logo In Sh.Shapes
                If Logo.Type = msoPicture Then Logo.Delete
            Next
         
            S1.Shapes(S1.Range("K1").Text).Copy
            Sh.Select
            Sh.Range("B2").Select
            Sh.Paste
            S1.Shapes(S1.Range("K2").Text).Copy
            Sh.Range("G2").Select
            Sh.Paste
            Sh.Range("A1").Select
        End If
    Next
 
    S1.Select
 
    Set S1 = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "Logo güncelleme işlemi tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

Allah razı olsun hocam sayfa sayısı artınca sürede artıyor ancak tamamen hızlandı excel çok işimi gördü çok teşekkür ederim.

Rizelli3 · 28 Ocak 2021

Korhan Ayhan' Alıntı:

LOGO sayfasında K1 ve K2 hücrelerine sayfalara kopyalanacak resim adlarını yazdıktan sonra aşağıdaki kodu denedim. Yaklaşık 2 saniyede logoları değiştiriyor.

C++:

Option Explicit

Sub Logolari_Guncelle()
    Dim S1 As Worksheet, Sh As Worksheet, Logo As Shape, Zaman As Double
 
    Zaman = Timer
 
    Application.ScreenUpdating = False
 
    Set S1 = Sheets("LOGO")
 
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> "LOGO" Then
            For Each Logo In Sh.Shapes
                If Logo.Type = msoPicture Then Logo.Delete
            Next
         
            S1.Shapes(S1.Range("K1").Text).Copy
            Sh.Select
            Sh.Range("B2").Select
            Sh.Paste
            S1.Shapes(S1.Range("K2").Text).Copy
            Sh.Range("G2").Select
            Sh.Paste
            Sh.Range("A1").Select
        End If
    Next
 
    S1.Select
 
    Set S1 = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "Logo güncelleme işlemi tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

Hocam son olarak logolar her sayfada aynı yerde değil genelde "F" ile başlayan sayfalarda aynı yerde bu kodu sadece "F" ile başlayan sayfalarda geçerli kılabilir miyiz.

Rizelli3 · 28 Ocak 2021

Aşağıdaki kod ile sorunu çözdüm.

Kod:

If Sh.Name <> "LOGO" And Left(Sh.Name, 1) = "F" Then

Rizelli3 · 28 Ocak 2021

Korhan Ayhan' Alıntı:

LOGO sayfasında K1 ve K2 hücrelerine sayfalara kopyalanacak resim adlarını yazdıktan sonra aşağıdaki kodu denedim. Yaklaşık 2 saniyede logoları değiştiriyor.

C++:

Option Explicit

Sub Logolari_Guncelle()
    Dim S1 As Worksheet, Sh As Worksheet, Logo As Shape, Zaman As Double
 
    Zaman = Timer
 
    Application.ScreenUpdating = False
 
    Set S1 = Sheets("LOGO")
 
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name <> "LOGO" Then
            For Each Logo In Sh.Shapes
                If Logo.Type = msoPicture Then Logo.Delete
            Next
         
            S1.Shapes(S1.Range("K1").Text).Copy
            Sh.Select
            Sh.Range("B2").Select
            Sh.Paste
            S1.Shapes(S1.Range("K2").Text).Copy
            Sh.Range("G2").Select
            Sh.Paste
            Sh.Range("A1").Select
        End If
    Next
 
    S1.Select
 
    Set S1 = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "Logo güncelleme işlemi tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

Hocam başını ağrıtıyorum ama sayfa sayısı çok olunca 40 - 80 sayfa arasına uyguluyor sonra aşağıdaki hatayı veriyor.

Buradan indirebilirsiniz.

Korhan Ayhan · 28 Ocak 2021

Ben 400 sayfada denedim. Hiç sorun çıkarmadı..

Rizelli3 · 28 Ocak 2021

Korhan Ayhan' Alıntı:
Ben 400 sayfada denedim. Hiç sorun çıkarmadı..

5-6 Denemede sayfaların tamamına logolar eklendi hocam çok teşekkür ederim yardımlarınız için.

Soru Makro İle Resim Değiştirme

Rizelli3

mancubus

Destek Ekibi

Picture Lookup in Excel using Named Ranges

Rizelli3

Picture Lookup in Excel using Named Ranges

mancubus

Destek Ekibi

Rizelli3

Korhan Ayhan

Administrator

Rizelli3

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

Rizelli3

Rizelli3

Rizelli3

Rizelli3

Korhan Ayhan

Administrator

Rizelli3