[Yardım]  Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

İleti#1)  OMERULLAH » 30 Kas 2018 19:08

Sayın Uzman arkadaşlar,

"A1" hücre koşuluna göre oda numarasına ait resimlerin "Resimler" klasörü ve alt klasörlerinden bularak, "C2:E51" aralığındaki birleştirilmiş hücrelere otomatik olarak transferinin sağlanmasını istiyorum.
Resimler 1034-00, 1034-01, 1034-02, 1034-03, 1035-00, 1035-01, 1035-02, 1035-03 şeklinde her oda için maximum 24 adet resime etiketlenmiştir. Resim adlarındaki ilk dört rakam oda numarasını, tireden(-) sonraki rakamlar ise odaya ait resim sayılarını ifade etmektedir. Örnek çalışmada 1034 ile 1035 nolu sayfalar örnek olması için yapılmıştır.
Kunuya hakim uzman arkadaşların çok değerli yardımlarını rica ediyorum.

Hayırlı akşamlar.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

Örnek Çalışma Link;
http://s3.dosya.tc/server18/l2me39/ARIZ ... I.rar.html
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
OMERULLAH
Siteye Alışmış
 
Adı Soyadı:ÖMER ÜZÜMCÜ
Kayıt: 06 Oca 2010 13:37
Konum: ANTALYA
Meslek: TURİZMCİ
Yaş: 50
İleti: 116
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANTALYA / MANAVGAT

Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

İleti#2)  askmadige34 » 01 Arl 2018 01:21

Aşağıdaki kodları deneyin. Yalnız dikey olan resimlerde boyutlandırmada sorun çıkartıyor.

Kod: Tümünü seç
Sub resim_ekle()
Dim Evn As Object
Dim ResimYolu As Variant
Dim resim As Object
Application.ScreenUpdating = False
On Error GoTo çıkış

ActiveSheet.DrawingObjects.Delete
Kat = Left(Range("A1"), 1) & "-Kat"

ResimYolu = ActiveWorkbook.Path & "\Resimler\" & Kat & "\"
Set Evn = CreateObject("scripting.filesystemobject")
Set klasor = Evn.getfolder(ResimYolu)
satir = 2
sutun = 3

For Each dosyalar In klasor.Files
    If Left(dosyalar.Name, 4) = Range("A1").Text Then
        Tresim = ResimYolu & dosyalar.Name
        Set resim = ActiveSheet.Pictures.Insert(Tresim)
        resim.ShapeRange.LockAspectRatio = msoFalse
       
        With Cells(satir, sutun)
            resim.Height = Range(Cells(satir, sutun), Cells(satir + 6, sutun)).Height - 1
            resim.Width = Range(Cells(satir, sutun), Cells(satir + 6, sutun)).Width
            resim.Top = .Top + 1
            resim.Left = .Left + 1
        End With
        If sutun < 5 Then
            sutun = sutun + 1
        Else
            satir = satir + 7
            sutun = 3
        End If
    End If
Next
çıkış:
Application.ScreenUpdating = True
End Sub
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 13:04
Meslek: memur
Yaş: 38
İleti: 1583
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

İleti#3)  OMERULLAH » 01 Arl 2018 10:19

Günaydın Sayın askmadige34,

Öncelikle konuya gösterdiğiniz ilgi ve yardım için size çok teşekkür ederim.
Verdiğiniz kodlar örnek sayfada bir sayfa için çalışmıştır. Anacak sayfaları çoğattığımız zaman yeni oluşturulan sayfalarda çalışmamaktadır. Vermiş olduğunuz kodları yeni eklenecek sayfalarda çalışabilmesi için bir düzenleme daha yapmanızı rica ediyorum.

Saygılarımla,
Ömer Ali ÜZÜMCÜ
Kullanıcı avatarı
OMERULLAH
Siteye Alışmış
 
Adı Soyadı:ÖMER ÜZÜMCÜ
Kayıt: 06 Oca 2010 13:37
Konum: ANTALYA
Meslek: TURİZMCİ
Yaş: 50
İleti: 116
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANTALYA / MANAVGAT

Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

İleti#4)  askmadige34 » 01 Arl 2018 13:56

Yeni sayfayı kopyalama ile mi oluşturuyorsunuz yoksa sağ tıklayıp sayfa ekle mi yapıyorsunuz. 1034 ve 1035 sayfalarında Change olayında kod mevcut. Yeni oluşturulan sayfada bu kodlar nasıl çalışıyor. Bu kodun içerisine benim eklediğim kodu Call resim_ekle şeklinde sizin change kodunun içerisine eklemeniz yeterli.
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 13:04
Meslek: memur
Yaş: 38
İleti: 1583
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma

İleti#5)  OMERULLAH » 01 Arl 2018 14:37

Sayın askmadige34,

Yeni sayfayı sağ tıklayıp sayfa ekle şeklinde çoğaltıyorum. Yeni sayfada yeni sayfaya ait kodları çalıştırdığımda, ilk sayfaya ait resimleri getiriyor. Sayfanın A1 hücresindeki oda numarasını referans olarak almıyor. Makro bana yabancı bir konu olduğu için kodları çalışmama göre düzenlemekte yetersiz kalıyorum. Sizde çalışıyor ise örnek çalışmayı upload edermisiniz lütfen. Belkide ben hata yapıyor olabilirim.
Beni anlayışla karşılayacağınız umut ediyorum.
Kolay gelsin.

Saygılarımla,
Ömer Ali ÜZÜMCÜ
Kullanıcı avatarı
OMERULLAH
Siteye Alışmış
 
Adı Soyadı:ÖMER ÜZÜMCÜ
Kayıt: 06 Oca 2010 13:37
Konum: ANTALYA
Meslek: TURİZMCİ
Yaş: 50
İleti: 116
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANTALYA / MANAVGAT

Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

İleti#6)  askmadige34 » 01 Arl 2018 15:16

A1 hücresinin ilk harfine göre kat bilgisini alıyor. Kat olarak almış olduğu bu klasörden resim çekiyor. Yani 1-Kat klasörünün içerisinde 1035 resimleri var ama 1034 resimleri yok. Bu klasörde 1034 resimleri olursa 1034 sayfasına resim getirir.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 13:04
Meslek: memur
Yaş: 38
İleti: 1583
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma

İleti#7)  OMERULLAH » 01 Arl 2018 15:31

askmadige34 yazdı:A1 hücresinin ilk harfine göre kat bilgisini alıyor. Kat olarak almış olduğu bu klasörden resim çekiyor. Yani 1-Kat klasörünün içerisinde 1035 resimleri var ama 1034 resimleri yok. Bu klasörde 1034 resimleri olursa 1034 sayfasına resim getirir.


Sayın askmadige34,
Anlatımınızdan yola çıkarak daha sonra tekrar sorun yaşayacağım şüphe götürmez bir gerçektir. Sorun tamamen benim sizi yanlış yönlendirmemden kaynaklamıştır. Örnek çalışmamdaki kat örneklemesindeki yanlışlığı aşağıdaki gibi ifade etmem gereklidir.

Zemin Kat = 1001-1060 arası, ( zemin kat yerine "00-Kat" ifadesini kullanabilirim.)
1-Kat = 1101-1160 arası
2-Kat = 1201-1260 arası
3-Kat = 1301-1360 arası
4-Kat = 1401-1460 arası
5-Kat = 1501-1560 arası şeklinde olmalıdır

Tekrar özür dilerim.
Saygılarımla,
Ömer Ali ÜZÜMCÜ
Kullanıcı avatarı
OMERULLAH
Siteye Alışmış
 
Adı Soyadı:ÖMER ÜZÜMCÜ
Kayıt: 06 Oca 2010 13:37
Konum: ANTALYA
Meslek: TURİZMCİ
Yaş: 50
İleti: 116
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANTALYA / MANAVGAT

Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

İleti#8)  askmadige34 » 01 Arl 2018 22:06

1036 resimleri normalde zemin katta olması gerekiyorken neden 2. katta peki. 1. Katta da 1035 resimleri mevcut.
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 13:04
Meslek: memur
Yaş: 38
İleti: 1583
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

İleti#9)  OMERULLAH » 01 Arl 2018 22:15

Örnek dosyayı oluştururken tarafımdan yapılmış bir hatadır.
Kullanıcı avatarı
OMERULLAH
Siteye Alışmış
 
Adı Soyadı:ÖMER ÜZÜMCÜ
Kayıt: 06 Oca 2010 13:37
Konum: ANTALYA
Meslek: TURİZMCİ
Yaş: 50
İleti: 116
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANTALYA / MANAVGAT

Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

İleti#10)  askmadige34 » 01 Arl 2018 23:17

1034 ve 1035 sayfalarında olması gereken resimler eklenmiş ve klasörlerdeki fotolarda olması gereken yerde tekrar atabilirseniz tam sonuca ulaşabiliriz.
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 13:04
Meslek: memur
Yaş: 38
İleti: 1583
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma

İleti#11)  OMERULLAH » 03 Arl 2018 09:13

askmadige34 yazdı:1034 ve 1035 sayfalarında olması gereken resimler eklenmiş ve klasörlerdeki fotolarda olması gereken yerde tekrar atabilirseniz tam sonuca ulaşabiliriz.


Günaydın, Sayın askmadige34,

Doğru örneklerin bulunduğu çalışma ekteki gibidir.
Size iyi hafta geçirmenizi dilerim.

Saygılarımla,
Ömer Ali ÜZÜMCÜ
Kullanıcı avatarı
OMERULLAH
Siteye Alışmış
 
Adı Soyadı:ÖMER ÜZÜMCÜ
Kayıt: 06 Oca 2010 13:37
Konum: ANTALYA
Meslek: TURİZMCİ
Yaş: 50
İleti: 116
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANTALYA / MANAVGAT

Cevap: Cevap: Cevap: Koşula Göre Farklı Klasörlerden Resim Ç

İleti#12)  OMERULLAH » 03 Arl 2018 09:18

Günaydın, Sayın askmadige34,

Doğru örneklerin bulunduğu çalışma ekteki gibidir.
Size iyi hafta geçirmenizi dilerim.

Saygılarımla,
Ömer Ali ÜZÜMCÜ[/quote]

Örnek Dosya Link:
https://www.dosyaupload.com/ehkN
http://s7.dosya.tc/server11/v06mgd/ARIZ ... 2.rar.html
Kullanıcı avatarı
OMERULLAH
Siteye Alışmış
 
Adı Soyadı:ÖMER ÜZÜMCÜ
Kayıt: 06 Oca 2010 13:37
Konum: ANTALYA
Meslek: TURİZMCİ
Yaş: 50
İleti: 116
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANTALYA / MANAVGAT

Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

İleti#13)  askmadige34 » 03 Arl 2018 23:31

Kodları aşağıdaki şekilde revize ederseniz sanırım olur.
Kod: Tümünü seç
Sub resim_ekle()
Dim Evn As Object
Dim ResimYolu As Variant
Dim Resim As Object
Application.ScreenUpdating = False
On Error GoTo çıkış
SayfaAdi = ActiveSheet.Name
If Left(SayfaAdi, 2) = "10" Then
    Kat = "Zemin Kat"
Else
    Kat = Mid(SayfaAdi, 2, 1) & "-Kat"
End If
Belirli_Bir_Alandaki_Resimleri_Sil
'ActiveSheet.DrawingObjects.Delete


ResimYolu = ActiveWorkbook.Path & "\Resimler\" & Kat & "\"
Set Evn = CreateObject("scripting.filesystemobject")
Set klasor = Evn.getfolder(ResimYolu)
satir = 2
sutun = 3

For Each dosyalar In klasor.Files
    If Left(dosyalar.Name, 4) = Range("A1").Text Then
        Tresim = ResimYolu & dosyalar.Name
        Set Resim = ActiveSheet.Pictures.Insert(Tresim)
        Resim.ShapeRange.LockAspectRatio = msoFalse
       
        With Cells(satir, sutun)
            Resim.Height = Range(Cells(satir, sutun), Cells(satir + 6, sutun)).Height - 1
            Resim.Width = Range(Cells(satir, sutun), Cells(satir + 6, sutun)).Width
            Resim.Top = .Top + 1
            Resim.Left = .Left + 1
        End With
        If sutun < 5 Then
            sutun = sutun + 1
        Else
            satir = satir + 7
            sutun = 3
        End If
    End If
Next
çıkış:
Application.ScreenUpdating = True
End Sub


Sub Belirli_Bir_Alandaki_Resimleri_Sil()
    Dim Resim As Picture, Alan As Range
    Set Alan = Range("C2:E100")
    For Each Resim In ActiveSheet.Pictures
        If Not Intersect(Resim.TopLeftCell, Alan) Is Nothing Then
            Resim.Delete
        End If
    Next
    Set Alan = Nothing
End Sub
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 13:04
Meslek: memur
Yaş: 38
İleti: 1583
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

Cevap: Koşula Göre Farklı Klasörlerden Resim Çağırma Yardımı

İleti#14)  OMERULLAH » 04 Arl 2018 09:11

Günaydın, Sayın askmadige34,

Konuya gösterdiğiniz ilgi, yardımınız ve sabrınız için size çok teşekkür ederim.
ALLAH sizden razı olsun.

Saygılarımla,
Ömer Ali ÜZÜMCÜ
Kullanıcı avatarı
OMERULLAH
Siteye Alışmış
 
Adı Soyadı:ÖMER ÜZÜMCÜ
Kayıt: 06 Oca 2010 13:37
Konum: ANTALYA
Meslek: TURİZMCİ
Yaş: 50
İleti: 116
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANTALYA / MANAVGAT


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: ctortumlu, Google Adsense [Bot], mutues, Vedat ÖZER ve 3 misafir

cron
Bumerang - Yazarkafe