Sicil numarasına göre farklı klasörden resim çağırma ve giriş sayfası

[teyadih]

Merhaba arkadaşlar. Belgeler/Personel/Personel Listeleri klasöründe bulunan 2.HAKİM VE PERSONEL BİLGİLERİ çalışma kitabındaki Hakim ve Personel sayfalarındaki B sütununda bulunan ve başka bir çalışma kitabından formülle alınan sicil numarasına göre Belgeler/Personel/Albüm klasöründe bulunan aynı sicile ait resmi örnekteki gibi C sütununda ayrılan yere sığacak şekilde alacak makro formülü ile açılış sayfası yapacak makro formülüne ihtiyacım var.
Farklı klasörden alındığından asıl dosyamda bulunduğu şekildeki örnek dosyayı ilişikte gönderiyorum.
Örnek belge Belgeler/Personel/Personel Listeleri klasöründe. Teşekkür ederim.

BELGELER.rar dosyasını indir - download

BELGELER.rar dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[byfika]

Merhabalar,
Kendi bilgisayarımda yol u alttaki gibi ayarladım.
Yol = "C:\Users\PC\Desktop\BELGELER\BELGELER\1.PERSONEL\ALBÜM\"
siz yolu kendi bilgisayarınıza göre ayarlayın,
B sütununa Bakanlık sicili girildiğinde ALBÜM klasöründeki Bakanlık sicil ile aynı isimdeki resim C sütununa gelecektir.

Örnek sayfa olarak HAKİMLER sayfasının kod bölümüne alttaki kodu girin,
İyi çalışmalar...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Resim As OLEObject, Yeni_Resim As OLEObject, Resim_Adres As Range, Yol As String, Resim_Adı As String
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Yol = "C:\Users\PC\Desktop\BELGELER\BELGELER\1.PERSONEL\ALBÜM\"
Resim_Adı = Target.Value & ".jpg"
Set Resim_Adres = Range(Target.Offset(0, 1).Address, Target.Offset(0, 1).Address)
If ActiveSheet.Shapes.Count > 0 Then
If Target = "" Then
For Each Resim In ActiveSheet.OLEObjects
If Not Intersect(Range(Resim.TopLeftCell.Address & ":" & Resim.TopLeftCell.Address), Resim_Adres) Is Nothing Then
Resim.Delete
End If
Next
Exit Sub
End If
End If
Set Yeni_Resim = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=Resim_Adres.Left, Top:=Resim_Adres.Top, Width:=Resim_Adres.Width, Height:=Resim_Adres.Height)
With Yeni_Resim
.Top = Resim_Adres.Top
.Left = Resim_Adres.Left
.Height = Resim_Adres.Height
.Width = Resim_Adres.Width
.Object.PictureSizeMode = fmPictureSizeModeStretch
End With
If Dir(Yol & Resim_Adı) <> "" Then
Yeni_Resim.Object.Picture = LoadPicture(Yol & Resim_Adı)
End If
Application.ScreenUpdating = True
End Sub

 

[teyadih]

Teşekkür ederim elinize sağlık

 

[byfika]

Rica ederim, İyi çalışmalar....

 

[teyadih]

Merhaba byfika makroyu uyguladım ancak sicil numaralarını tekrar yazdığımda resimleri resimdeki gibi boş olarak alıyor. Örnek belge masaüstünde ama bir yerde hatamı yaptım acaba bakabilir misiniz?
Daha önce açıklama da belirttiğim üzere sicil numaralarını formülle aldığım için fotoğrafların gelmesi için makro sorgulama diye bir tuş koyulması gerekiyor sanırım.
Birde açıklamada belirttiğim üzere hangi sayfada kapatırsam kapatayım çalışma sayfasını açtığımda GİRİŞ SAYFASININ açılması için de bir kod yazabilir misiniz?
Sayın byfika açıklamada belirttiğim üzere makro konusunda pek bir bilgim yok. Size zahmet resim çekme ile giriş sayfasının açılış sayfası olmasına ilişkin kodları örnek çalışma kitabına yükleyebilir misiniz size zahmet.
Asıl belgem D de paylaşım klasörünün içinde Resimler PAYLAŞIM/BELGELER\BELGELER\1.PERSONEL\ALBÜM klasöründe,
çalışma sayfası ise PAYLAŞIM/BELGELER\BELGELER\1.PERSONEL\PERSONEL LİSTELERİ klasöründe
Tekrar teşekkür ederim.

 

[byfika]

Merhabalar,
D ye PAYLAŞIM adında bir klasör açın ve içine resimlerin içinde olduğu ALBÜM klasörünü PAYLAŞIM klasörü içine atın. Resim yolu olarak da D deki PAYLAŞIM klasörü içindeki ALBÜM klasörünü gösterdim.
Gönderdiğim Exceli masa üstünde veya D de PAYLAŞIM klasörü içinde atın ve HAKİM&PERSONEL sayfasında işlem yapın ( kodu bu sayfaya ayarladım) B sütununa sicil girilince resimler gelecektir .
Resim yolu : Yol = "D:\PAYLAŞIM\ALBÜM\"
Sadece exceli ekliyorum.
Deneyiniz.

 

[teyadih]

Teşekkür ederim kontrol edip dönüş yapacağım

 

[erenli5252]

İyi günler sicili sağ tarafa yazıp resmi sol tarafa getirmek ve resim formatını da png olarak bu formüle nasıl uygularız Teşekkür ederim

 

[erenli5252]

İyi günler sicili sağ tarafa yazıp resmi sol tarafa getirmek ve resim formatını da png olarak bu formüle nasıl uygularız Teşekkür ederim