[muhit01]

personel bilgi formu.zip

merhaba öncelikle ismim muhittin
formda yeniyim inanın çok araştırdım fakat ne yaptıysam olmadı beceremedim ve gerçekten yardıma ihtiyacım var
ekte personel bilgileri ile ilgili bir excel hazırladım fakat klasör içerisindeki resimleri personel ismine göre resim alanına getirmeyi başaramadım lütfen yardım edin bir haftadır araştırıyorum .
şimdiden teşekkürlerimi sunarım .

değerli site yöneticilerim konuyu yanlış yere açtıysam sizlerdende özür dilerim .

herkese saygılar .

[rastbin]

Kod: Tümünü seç

   
        With ActiveSheet.Pictures.Insert("resim yolu")
            .Left = 500
            .Top = 700
            .Width = 123
            .Height = 134
        End With
    End If

resme sağ tıkla özellikler de konumdaki yazanı al "resim yolu" yazan yere yapıştır.

[tasad]

Sheet2 kod bölümünü tamamen sil ve aşağıdaki kodları kaydet.

Kod: Tümünü seç

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c6]) Is Nothing Then Exit Sub
'ActiveSheet.DrawingObjects.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("c6") & ".gif"
Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
     With Range("g10")
     Resim.Top = .Top
     Resim.Left = .Left
     Resim.Height = .Height
     Resim.Width = .Width
     End With
End Sub


[rastbin]

arkadaşın paylaştığı kodun en başına

Kod: Tümünü seç

ActiveSheet.Pictures.Delete

ekleyiniz.resimleri üst üste kaydeder yoksa.

[muhit01]

Sheet2 kod bölümünü tamamen sil ve aşağıdaki kodları kaydet.

Kod: Tümünü seç

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c6]) Is Nothing Then Exit Sub
'ActiveSheet.DrawingObjects.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("c6") & ".gif"
Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
     With Range("g10")
     Resim.Top = .Top
     Resim.Left = .Left
     Resim.Height = .Height
     Resim.Width = .Width
     End With
End Sub


tasad ve rastbin hocam ikinizede teşekkürlerimi sunarım .
evet tasad hocamın verdiği kod süper oldu rastbin hocam sizde haklısınız denedim şimdi resimleri üst üste kaydediyor verdiğiniz kodu tasad hocamın verdiği kodun en başına yapıştırdıgımda hata veriyor nasıl düzeltebilirim acaba
ikinizede saygılarımı sunarım .

[rastbin]

Kod: Tümünü seç

Private Sub Worksheet_Change(ByVal Target As Range)

hemen altına yapıştırınız.

[muhit01]

Sheet2 kod bölümünü tamamen sil ve aşağıdaki kodları kaydet.

Kod: Tümünü seç

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c6]) Is Nothing Then Exit Sub
'ActiveSheet.DrawingObjects.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("c6") & ".gif"
Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
     With Range("g10")
     Resim.Top = .Top
     Resim.Left = .Left
     Resim.Height = .Height
     Resim.Width = .Width
     End With
End Sub


tasad ve rastbin hocam ikinizede teşekkürlerimi sunarım .
evet tasad hocamın verdiği kod süper oldu rastbin hocam sizde haklısınız denedim şimdi resimleri üst üste kaydediyor verdiğiniz kodu tasad hocamın verdiği kodun en başına yapıştırdıgımda hata veriyor nasıl düzeltebilirim acaba
ikinizede saygılarımı sunarım .

hocalarım her ikinizdende özür dilerim tasad hocamın kodu mükemmel çalışıyor elinize sağlık . rastbin hocam gönderdiğiniz kodu yanlış yere yapıştırmışım düzelttim gayet sağlıklı çalışıyor sizinde elinize sağlık
her ikinizede tekrar tekrar teşekkürlerimi sunarım
saygılar .

[muhit01]

hocalarım çok özür dilerim bir noktada daha değerli yardımlarınıza ihtiyacım var .
çalışma sayfası ile resimler aynı klasörde dolaysiyle resimler çoğaldıkça sorun olacak sanıyorum
çalışma sayfasının bulunduğu klasör içine ( RESİMLER ) isminde bir klasör daha oluşturup resimleri o klasör içinden çağırmak istiyorum
kodda nasılbir değişiklik yapmam gerek acaba

Saygılar.

[şahin]

Dosyanız ekte. Klasörden resmi isim üzerinden değilde sicil no üzerinden arama yapacak, birden fazla aynı isimde kişi olabileceğinden dolayı..

personel bilgi formu.rar

[tasad]

Aşağıdaki kodlar işinizi görür.

Kod: Tümünü seç

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c6]) Is Nothing Then Exit Sub
ActiveSheet.Pictures.Delete
Dim ResimDosyaYolu As String
Dim Resim As Object
ResimDosyaYolu = ThisWorkbook.Path & "\resimler\" & Range("c6") & ".gif"
Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
     With Range("g10")
     Resim.Top = .Top
     Resim.Left = .Left
     Resim.Height = .Height
     Resim.Width = .Width
     End With
End Sub


[şahin]

hocalarım çok özür dilerim bir noktada daha değerli yardımlarınıza ihtiyacım var .
çalışma sayfası ile resimler aynı klasörde dolaysiyle resimler çoğaldıkça sorun olacak sanıyorum
çalışma sayfasının bulunduğu klasör içine ( RESİMLER ) isminde bir klasör daha oluşturup resimleri o klasör içinden çağırmak istiyorum
kodda nasılbir değişiklik yapmam gerek acaba

Saygılar.

Kod: Tümünü seç

ResimDosyaYolu = ActiveWorkbook.Path & "\" & Range("c6") & ".gif"

bu satırı aşağıdaki satır ile değiştirin

Kod: Tümünü seç

ResimDosyaYolu = ActiveWorkbook.Path & "\RESİMLER\" & Range("c6") & ".gif"

[muhit01]

Dosyanız ekte. Klasörden resmi isim üzerinden değilde sicil no üzerinden arama yapacak, birden fazla aynı isimde kişi olabileceğinden dolayı..

personel bilgi formu.rar

Şahin hocam merhaba kesinlikle doğru tespitiniz ben bunu düşünememiştim

sizden esinlenerek Tc isim ve tc numaraları ile resim çağırmak iyi olacak sanırım .
Hocam birde sizlerden ricam tablodaki tüm alanları resimde dahil olmak üzere
önce proje seç bölümünden projeyi seçtikten sonra sadece o projedeki tüm personellerin Personel seç bölümüne gelmesi
Personel seç bölümünden de personeli seçince seçilen personele ait tüm bilgilerin karttaki yerlerine otomatik veri tabanından çekilip eklenmesi .

Düşeyara ve benzeri kodlarla yapmaya çalıştım ama olmadı yardımcı olursanız çok sevinirim
veri tabanı bu kadar değil tabi ama ortalama 1000 personel olacak

Değerli Yardımlarınızı Rica Ederim

SAYGILARIMLA .

[şahin]

Ekte

PERSONEL BİLGİ KARTI.rar

[muhit01]

Ekte

PERSONEL BİLGİ KARTI.rar

Şahin Hocam merhaba ,

çok teşekkür ederim elinize sağlık hocam.

hocam veriler yerine oturuyor fakat resimler personele göre değişmiyor nasıl düzeltebilirim şahin hocam

saygılarımla .

[muhit01]

Ekte

PERSONEL BİLGİ KARTI.rar

Şahin Hocam merhaba ,

çok teşekkür ederim elinize sağlık hocam.

hocam veriler yerine oturuyor fakat resimler personele göre değişmiyor nasıl düzeltebilirim şahin hocam

saygılarımla .

şahin hocam şimdi birşey dikkatimi çekti personel bilgileri iki ayrı pc de de yerine oturuyor fakat resimler pc nin birinde değişirken diğer pc de değişmiyor acaba sebebi nedir hocam .

saygılar.

[şahin]

Klasörü zip dosyasından çıkarın masüstüne c: veya d: nin içerisine orada çalıştırın.

[muhit01]

Klasörü zip dosyasından çıkarın masüstüne c: veya d: nin içerisine orada çalıştırın.

Şahin Hocam çok özür dilerim sürekli rahatsızlık veriyorum .
denedim C içinde hocam yine resimler sabit kalıyor .

yardımcı olursanız çok sevinirim hocam .

saygılarımla .

[şahin]

Ahmet Türkmen ile Mustaf ünlünün resimleri var, aşağıdaki zip.indirin klsörü çıkartın yeniden deneyin, ne hatası verecek bakalım, bende çalışıyor, birde makro güvenlik ayarlarını kontrol edin..

[muhit01]

Ahmet Türkmen ile Mustaf ünlünün resimleri var, aşağıdaki zip.indirin klsörü çıkartın yeniden deneyin, ne hatası verecek bakalım, bende çalışıyor, birde makro güvenlik ayarlarını kontrol edin..

Tekrar Merhaba şahin Hocam ,

Hocam macro güvenlik ayarlarında da her seçeneği denedim yine resim aynı bilgiler değişiyor resim değişmiyor .
ne yaptıysam olmadı hocam . Diğer pc de çok güzel çalışıyor

[şahin]

Ofis sürümü eski mi acaba çalışmayan bilgisayarda, bende de sıkıntı yok çalışıyor, bir hata veriyor mu ismi değiştirdiğinde ?