Userform'a fotoğraf koymak

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,254
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu şekilde kullanımda genelde dosyada yavaşlama ve boyut büyüme yaşanıyor.

Tabiki tercih sizin. Sonuçta siz kullanacaksınız.
 
Katılım
15 Aralık 2008
Mesajlar
202
Excel Vers. ve Dili
excel 2010
Hocam listeye tıklayınca, bilgilerle beraber fotoğraf da gelsin istediğim. Ama siliniyor
Korhan Hocamın dedikleri paralelinde;

Kod:
Private Sub resim_getir ()
Dim ResimAdi As String, ResimKlasoru As String, DosyaYolu As String,  TamDosyaYolu As String

'Resim dosyası ve resim klasorunu alma
ResimAdi = ActiveCell.Value
ResimKlasoru = "images\"
DosyaYolu = NavigateFromWorkBookPath ()

'Resim yolunu alma
TamDosyaYolu = DosyaYolu & ResimKlasoru & ResimAdi

'resmi pictureboxa yükleme
If Dir(TamDosyaYolu) <> "" Then
Image1.Picture = LoadPicture(TamDosyaYolu)
Image1.PictureSizeMode = 3
Else
Msgbox "Resim dosyası yüklenemedi - Dosya bulunamadı"
End If
End Sub

Private Function NavigateFromWorkBookPath () As String
Dim DosyaKlasorYolu As String, Slashisareti As Integer, ResimKlasorYolu As String
DosyaKlasorYolu = ThisWorkbook.Path
Slashisareti = InStrRev(DosyaKlasorYolu, "\")
ResimKlasorYolu = Left(DosyaKlasorYolu, Slashisareti)
NavigateFromWorkbookPath = ResimKlasorYolu
End Function
Buraya aktif hücre değerine göre değişen değerler verilebilir.. (Altın üye olmadığımdan örnek dosya indiremiyorum, bu yüzden editleme işi size ait @muratgunay48 )
 

Mahmut Bayram

Özel Üye
Katılım
25 Haziran 2005
Mesajlar
1,778
Excel Vers. ve Dili
2016 Excel Tr
Şu dosyayı inceleyiniz AllahuAlem böyle bir şey istiyorsunuz.
2.Mesajdaki dosya.
 

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,182
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2025
Şu dosyayı inceleyiniz AllahuAlem böyle bir şey istiyorsunuz.
2.Mesajdaki dosya.
Hocam şu an bilgisayarda değilim ama, yazıyı okuduğum kadarıyla aynen böyle.
Teşekkür ederim.
 

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,182
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2025
Korhan Hocamın dedikleri paralelinde;

Kod:
Private Sub resim_getir ()
Dim ResimAdi As String, ResimKlasoru As String, DosyaYolu As String,  TamDosyaYolu As String

'Resim dosyası ve resim klasorunu alma
ResimAdi = ActiveCell.Value
ResimKlasoru = "images\"
DosyaYolu = NavigateFromWorkBookPath ()

'Resim yolunu alma
TamDosyaYolu = DosyaYolu & ResimKlasoru & ResimAdi

'resmi pictureboxa yükleme
If Dir(TamDosyaYolu) <> "" Then
Image1.Picture = LoadPicture(TamDosyaYolu)
Image1.PictureSizeMode = 3
Else
Msgbox "Resim dosyası yüklenemedi - Dosya bulunamadı"
End If
End Sub

Private Function NavigateFromWorkBookPath () As String
Dim DosyaKlasorYolu As String, Slashisareti As Integer, ResimKlasorYolu As String
DosyaKlasorYolu = ThisWorkbook.Path
Slashisareti = InStrRev(DosyaKlasorYolu, "\")
ResimKlasorYolu = Left(DosyaKlasorYolu, Slashisareti)
NavigateFromWorkbookPath = ResimKlasorYolu
End Function
Buraya aktif hücre değerine göre değişen değerler verilebilir.. (Altın üye olmadığımdan örnek dosya indiremiyorum, bu yüzden editleme işi size ait @muratgunay48 )
Hocam ilk bölüm resim adı ve bulunduğu klasör mü.
Yani ResimAdi = .......
Resim klasörü = "C\....." gibi
 
Katılım
15 Aralık 2008
Mesajlar
202
Excel Vers. ve Dili
excel 2010
resim adı = activecell yerine herhangi bir nesne (combobox - TextBox) veya bir hücre değeri Sheets(1).Range("A1") gibi konulabilir.
 

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,182
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2025
Korhan Hocamın dedikleri paralelinde;

Kod:
Private Sub resim_getir ()
Dim ResimAdi As String, ResimKlasoru As String, DosyaYolu As String,  TamDosyaYolu As String

'Resim dosyası ve resim klasorunu alma
ResimAdi = ActiveCell.Value
ResimKlasoru = "images\"
DosyaYolu = NavigateFromWorkBookPath ()

'Resim yolunu alma
TamDosyaYolu = DosyaYolu & ResimKlasoru & ResimAdi

'resmi pictureboxa yükleme
If Dir(TamDosyaYolu) <> "" Then
Image1.Picture = LoadPicture(TamDosyaYolu)
Image1.PictureSizeMode = 3
Else
Msgbox "Resim dosyası yüklenemedi - Dosya bulunamadı"
End If
End Sub

Private Function NavigateFromWorkBookPath () As String
Dim DosyaKlasorYolu As String, Slashisareti As Integer, ResimKlasorYolu As String
DosyaKlasorYolu = ThisWorkbook.Path
Slashisareti = InStrRev(DosyaKlasorYolu, "\")
ResimKlasorYolu = Left(DosyaKlasorYolu, Slashisareti)
NavigateFromWorkbookPath = ResimKlasorYolu
End Function
Buraya aktif hücre değerine göre değişen değerler verilebilir.. (Altın üye olmadığımdan örnek dosya indiremiyorum, bu yüzden editleme işi size ait @muratgunay48 )
Hocam, bunu fotoğraf seç butonuna mı bağlayacağım.
 

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,182
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2025
Merhaba;
Ekteki uygulamayı inceleyin. (size fikir verecektir)
İyi çalışmalar.
Hocam, kafam karıştı. Fotoğraftaki bölümlerin tamamını mı alacağım. Hepsinde Image2 geçiyor. Label18 olanları. Size zahmet baksanız.
Teşekkür ederim. Ayrıca, hepsini alırsam mükerrer başlık hatası veriyor.
Ekran Alıntısı.PNG
 
Katılım
15 Aralık 2008
Mesajlar
202
Excel Vers. ve Dili
excel 2010
Hocam, kafam karıştı. Fotoğraftaki bölümlerin tamamını mı alacağım. Hepsinde Image2 geçiyor. Label18 olanları. Size zahmet baksanız.
Teşekkür ederim. Ayrıca, hepsini alırsam mükerrer başlık hatası veriyor.
Ekli dosyayı görüntüle 222893
ben dosyayı göremediğim için (Altın üye değilim - kredi kartı kullanmıyorum..) en sade şekliyle yazdım kodları, mesela orada İmage1, resim adı, resim klasörü vs kısımları kendi dosyanıza uyarlamanız lazım..
 

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,182
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
Altın Üyelik Bitiş Tarihi
31-01-2025
Fonksiyonu Modül içine alın.. resim getir ise nesne (Cmdbutton vs) üzerinde kalsın
Şimdi alıyorum hocam.
Hocam, yapamadım sanırım
Resmin bulunduğu klasör...
C:\Users\muratgunay48\Desktop\resim\
Resmin adı...
minik.jpg
Userform'da kişilerin fotoğraflarının geleceği yer... Image2
Size zahmet yerlerine koyabilir misiniz. Boyuna hata veriyor.
 
Üst