[Yardım]  Kapalı Dosyalardan Koşula Göre Sayfa Görselini Çağırma Yard.

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

Kapalı Dosyalardan Koşula Göre Sayfa Görselini Çağırma Yard.

İleti#1)  OMERULLAH » 10 Ekm 2018 13:21

Sayın Uzman Arkadaşlar,

Aşağıda açıkladığım çalışmayı sitedeki örnekleri inceleyerek yapamadım ve oldukça fazla zaman harcadım. Dolayısıyla konuya hakim uzman arkadaşların yardımına ihtiyaç duymaktayım.
Bir klasör içerisinde "Personel Bilgileri" isimli çalışma kitabım bulunmaktadır. Bunun yanında "Resimler" ve "Data" isimlerinde iki adet daha klasör bulunmaktadır. "Data" ismli klasörlerin içerisinde ise bir çok çalışma kitabı bulunacak olup, kitapların sayfaları ise personelin adı ve soyadından oluşmaktadır.
Personel Bilgileri katabının yine aynı isme sahip sayfasının "C3" hücresine yazılan personel ismini, "Data" klasöründeki çalışma kitaplarında arayarak, personele ait sayfadaki verilerin görselini çağırmak istiyorum.
Daha detaylı anlatım örnek çalışmada bulunmakta olup, siz uzman arkadaşların çok değerli yardımlarını rica ediyorum.

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

https://www.dosyaupload.com/ilzR
http://s3.dosya.tc/server17/tx8qq4/Pers ... 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: Kapalı Dosyalardan Koşula Göre Sayfa Görselini Çağırm

İleti#2)  feraz » 11 Ekm 2018 02:47

Merhaba.

Dener misiniz?

Not:Personel_Bilgileri sayfasındaki 25.ci satırdaki resimler her isim seçiminden sonra üst üste geliyor.
Bu for each kodu ile silinir.Tabi koşul eklemek gerek diğer resim vs.. silinmemesi için.

Kod: Tümünü seç
Sub resmgtr()

Dim klasor, ws As Worksheet


Application.ScreenUpdating = False

With Workbooks(ThisWorkbook.Name).Sheets("Personel_Bilgileri")



For Each klasor In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\Data").Files

    Workbooks.Open klasor
    Windows(klasor.Name).Visible = False
    Workbooks(ThisWorkbook.Name).Activate
   
    For Each ws In Workbooks(klasor.Name).Sheets
   
            If ws.Name = .Range("C3").Value Then
               Workbooks(klasor.Name).Sheets(.Range("C3").Value).Range("A1:F70").Copy
              .Range("A25:F100").Select
               ActiveSheet.Pictures.Paste
              Workbooks(klasor.Name).Application.CutCopyMode = False

            End If
   
    Next
   
    Workbooks(klasor.Name).Close False
Next

End With

Application.ScreenUpdating = True

Set ws = Nothing

End Sub


Kod: Tümünü seç
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [C3]) Is Nothing Then Exit Sub
On Error Resume Next

With Sheets("Personel_Bilgileri")
    .Image1.Picture = LoadPicture("")
    .Image1.PictureSizeMode = fmPictureSizeModeStretch
    .Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Resimler\" & .[C3] & ".jpg")
    .[C3].Select
   Call resmgtr
End With

End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5541
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Kapalı Dosyalardan Koşula Göre Sayfa Görselini Çağırm

İleti#3)  OMERULLAH » 11 Ekm 2018 10:10

Sayın Feraz,

Öncelikle konuya gösterdiğiniz ilgi ve yardımınız için size çok teşekkür ederim.
Personel_Bilgileri sayfasındaki 25.ci satırdaki resimler her isim seçiminden sonra üst üste gelmemesi için "for each" kodu entegre etmeniz daha makbule geçecektir.

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: Kapalı Dosyalardan Koşula Göre Sayfa Görselini Çağırm

İleti#4)  feraz » 11 Ekm 2018 15:22

Rica ederim.Dün fazla zamanım yoktu bu yüzden bitirememiştim.
Belkide for eache gerek kalmaz eklenen resimin adını buldurursam.
Akşam yaparım nasipse.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5541
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

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

Cevap: Cevap: Kapalı Dosyalardan Koşula Göre Sayfa Görselini

İleti#5)  OMERULLAH » 11 Ekm 2018 20:35

feraz yazdı:Rica ederim.Dün fazla zamanım yoktu bu yüzden bitirememiştim.
Belkide for eache gerek kalmaz eklenen resimin adını buldurursam.
Akşam yaparım nasipse.


Sayın Feraz,

Departman müdürleri performans değerlendirmelerini yaparak, bu belgeyi kişinin kendisine imzalatarak bize göndermektedirler. Bu sebep ile imzalı gerçek belgeleri scan yapmak durumunda kaldımız için, mevcut uygulamanın Data klasöründe değşiklik yaptık. Kişilere ait PDF formatındaki gerçek dökümanları excel içerisine taşımamıza gerek kalmamıştır. "Personel Bilgileri" sayfasının C3 hücresine yeni bir isim yazıldığı zaman, veya "Veritabanı" sayfasındaki isimlerin üzerine Double Click yapılınca, o kişiye ait PDF dosyasını açması yeterli olacaktır.
Çalışmayı şekillenen yani hali ile tamamlarsanız çok makbule geçecektir.
Hayırlı akşamlar, kolay gelsin.

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

http://dosya.co/8yj9i2pzp3d4/Personel_B ... i.rar.html
http://s3.dosya.tc/server17/zh4i8k/Pers ... i.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: Kapalı Dosyalardan Koşula Göre Sayfa Görselini Çağırm

İleti#6)  feraz » 11 Ekm 2018 22:32

Ben yinede yapmıştım dosyayı ekleyeyim belki lazım olabilir.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5541
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Kapalı Dosyalardan Koşula Göre Sayfa Görselini Çağırm

İleti#7)  feraz » 11 Ekm 2018 23:53

Merhaba alttaki kod işinizi görür.
Ayrıyeten resimdekini eklemeniz gerek en üstteki resim için.

http://s3.dosya.tc/server17/it8qpr/Pers ... 3.rar.html

Kod: Tümünü seç
Sub Pdf_resmgtr()

    Dim klasor As Object, pdfler As Object

    For Each klasor In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\Data").SubFolders
   
        For Each pdfler In klasor.Files
   
        If Left(LCase(CreateObject("Scripting.FileSystemObject").GetExtensionName(pdfler)), 3) = "pdf" Then
            If pdfler.Name = ThisWorkbook.Sheets("Personel_Bilgileri").[C3] & ".pdf" Then
              CreateObject("Shell.Application").Open (pdfler & "")
              Exit For
           End If
        End If
   
        Next
    Next
Set klasor = Nothing: Set pdfler = Nothing


End Sub

Kod: Tümünü seç

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [C3]) Is Nothing Then Exit Sub
    On Error Resume Next
   
    With Sheets("Personel_Bilgileri")
        .Image1.Picture = LoadPicture("")
        .Image1.PictureSizeMode = fmPictureSizeModeStretch
        .Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Resimler\" & .[C3] & ".jpg")
        .[C3].Select
       Call Pdf_resmgtr
    End With

End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5541
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Kapalı Dosyalardan Koşula Göre Sayfa Görselini Çağırm

İleti#8)  feraz » 12 Ekm 2018 01:02

Kod yavaş çalışırsa alttaki kodu uygulayınız.Öncekinde gereksizkod eklemişim.

Kod: Tümünü seç
Sub Pdf_resmgtr()

    Dim klasor As Object, pdfler As Object

    For Each klasor In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\Data").SubFolders
        For Each pdfler In klasor.Files
            If pdfler.Name = ThisWorkbook.Sheets("Personel_Bilgileri").[C3] & ".pdf" Then
              CreateObject("Shell.Application").Open (pdfler & "")
              GoTo var
           End If
        Next
    Next
var:
Set klasor = Nothing: Set pdfler = Nothing

End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5541
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Kapalı Dosyalardan Koşula Göre Sayfa Görselini Çağırm

İleti#9)  OMERULLAH » 12 Ekm 2018 11:19

Sayın Feraz,

Harika bir çalışma olmuş, konuya gösterdiğiniz ilgi ve benim için çok değerli olan yardımınız için size çok teşekkür ederim.
ALLAH sizden razı olsun ve dilediğiniz herşeyi hayırlısı ile gönlünüze göre versin.

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: Kapalı Dosyalardan Koşula Göre Sayfa Görselini Çağırm

İleti#10)  feraz » 12 Ekm 2018 12:27

Rica ederim.
Allah sizdende razı olsun.

Kolay gelsin.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5541
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot, Google [Bot] ve 0 misafir

Bumerang - Yazarkafe