Excel VBA resim kaydetme

[saviola26]

Merhaba hocalarım.
1- Ekteki örnekte bir kayıt sistemi oluşturdum. Gözat butonuna tıklayarak resim seçtikten sonra kayıt yapabiliyor. Ancak resim resçmeden kayıt yaparsa hata alıyorum bunu çözemedim bir türlü.

2- Bir de Cinsiyeti de option yaptım. Onu da çalışma sayfasına kız veya erkek olarak atsın. Sonra bul deyince de option seçili gelsin istiyorum.

Yardımlarınız için teşekkürler.

 

[askm]

Dosyanız ektedir.

 

[saviola26]

Çok sağolun hocam çok teşekkür ederim.

 

[saviola26]

Hocam aynı örnekte arama yaptırdıgımda da şunu istiyorum. Aradı eğer resim yoksa iccon isimli resmi yüklesin. Varsa zaten tc ile kayıt ediliyor. O resmi yüklesin picture a. yardımcı olursanız sevinirim

 

[askm]

Öğleden sonra bilgisayar başına geçince bakarım inşallah.

 

[askm]

dosya = ThisWorkbook.Path & "\resimler\" & TextTc.Text & ".jpg"
eski = ThisWorkbook.Path & "\resimler\" & "iccon" & ".jpg"
If Dir(dosya) <> "" Then
    Image1.Visible = True
    Image1.Picture = LoadPicture(dosya)
    Image1.PictureSizeMode = fmPictureSizeModeStretch
Else
    Image1.Visible = True
    Image1.Picture = LoadPicture(eski)
    Image1.PictureSizeMode = fmPictureSizeModeStretch
End If

 

[saviola26]

Çok Teşekkürler. Çok iyi oldu benim için.

 

[askm]

Rica ederim.

 

[saviola26]

Hocam çok uğraştırdım sizi ama
1- Kayıt yaparken resim yoksa sorun yok. Diğer verileri kaydediyor. Ama resim seçtiysem tc numarası.jpg olacak şekilde onu da resimler adlı klasöre kayıt etmesi gerekiyor. Bunu yapmıyor şimdi de. Böyle olunca ara ve güncelle ekranlarını da tamamlayamadım. Yardımcı olursanız sevinirim. 2 adet resimde gönderdim size.

2- Arama yaptığımda bazan cinsiyet işaretleniyor bazen işaretlenmiyor.

Dosyamın son haini de yüklüyorum.

 

[saviola26]

Yardımcı olabilecek yok mu arkadaşlar!

 

[askm]

Kayıt işleminde <> işaretini = olarak değiştirin.Ayrıca KisiselBilgiler E sütununda cinsiyet yazılı değilse aramada seçili gelmesini beklemek doğru olur mu? Şartı boş ise ERKEK seç ya da KIZ seç yapmadı iseniz gelmez.

If Dir(ThisWorkbook.Path & "\Resimler\" & TextTc.Text & ".jpg") = "" Then
    alan = ResimObjesi.CopyFile(TextResim.Text, ThisWorkbook.Path & "\Resimler\" & TextTc.Text & ".jpg")
End If

 

[saviola26]

Kayıt işleminde <> işaretini = olarak değiştirin.Ayrıca

If Dir(ThisWorkbook.Path & "\Resimler\" & TextTc.Text & ".jpg") = "" Then
    alan = ResimObjesi.CopyFile(TextResim.Text, ThisWorkbook.Path & "\Resimler\" & TextTc.Text & ".jpg")
End If

Hocam bu söylediğinizi yapınca gözata tıklayıp resim seçersem ekliyor. Ama resim seçmeyi unutursam hata alıyor. İstediğimiz ise resim seçerse o resmi kaydetsin. Ama seçmezse bir sorun çıkmasın. Arama yaptığımda da o kişiye resim kaydedilmişse o gelecek. Resim kaydı yapılmamışsa iccon yazan resim gelecek. İlginiz için çok teşekkür ederim.

 

[halit3]

9 nolu mesajınnızdaki dosya için kod

Dosya = ThisWorkbook.Path & "\" & TextTc.Text & ".jpg"
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
resim = Dosya
Else
resim = ThisWorkbook.Path & "\resimler\" & "iccon" & ".jpg"
End If
Image1.Picture = LoadPicture(None)
Image1.Visible = True
Image1.Picture = LoadPicture(resim)
Image1.PictureSizeMode = fmPictureSizeModeStretch

 

[saviola26]

9 nolu mesajınnızdaki dosya için kod

Dosya = ThisWorkbook.Path & "\" & TextTc.Text & ".jpg"
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
resim = Dosya
Else
resim = ThisWorkbook.Path & "\resimler\" & "iccon" & ".jpg"
End If
Image1.Picture = LoadPicture(None)
Image1.Visible = True
Image1.Picture = LoadPicture(resim)
Image1.PictureSizeMode = fmPictureSizeModeStretch

Maalesef olmuyor hocam. Kayıt başarılı diyor ama resim kaydetmiyor.

 

[askm]

If TextResim.Text <> "" And Dir(ThisWorkbook.Path & "\Resimler\" & TextTc.Text & ".jpg") = 
"" Then
    alan = ResimObjesi.CopyFile(TextResim.Text, ThisWorkbook.Path & "\Resimler\" & TextTc.Text & ".jpg")
End If

 

[saviola26]

If TextResim.Text <> "" And Dir(ThisWorkbook.Path & "\Resimler\" & TextTc.Text & ".jpg") = 
"" Then
    alan = ResimObjesi.CopyFile(TextResim.Text, ThisWorkbook.Path & "\Resimler\" & TextTc.Text & ".jpg")
End If

Çok çok çok teşekkürler. Tüm işlemleri yapıyor şu anda. Sadece resim sağa dönmüş geliyor. image1 nesnesinin içine. o da resimden kaynaklanıyor olabilir. halit3 hocam sizin de emeğinize sağlık. Teşekkür ederim.

 

[askm]

Resimde yatık olduğu için o şekilde geliyor.