• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Gözat Seçeneği

R

Rizelli3

Katılım
1 Mart 2017
Mesajlar
101
Excel Vers. ve Dili
Microsoft Office 2015
Türkçe
Merhabalar,

Adreste bulunan örnek dosyama User Form ekledim kişi ekle butonuna bastığımda kişileri tabloya işliyor. Ancak tablonun sağ tarafındaki kısıma User Form'da bulunan göz at seçeneğine tıklayıp kişinin resmini de eklemek istiyorum. Bu konuda yardımcı olur iseniz çok sevinirim. Şimdiden teşekkür ederim. Herkese iyi çalışmalar dilerim.

http://s9.dosya.tc/server2/lml86c/Ornek_Dosya.rar.html
 
Merhaba
Aşağıdaki kodları deneyin.
Kod: 
[SIZE="2"]Private Sub CommandButton2_Click()
Dim fn
    fn = Application.GetOpenFilename(FileFilter:="Resim (*.gif;*.jpg;*.jpeg;*.bmp),*.gif;*.jpg;*.jpeg;*.bmp", _
    Title:="Resim Seç")
    If fn = False Then
MsgBox "Resim seçin"
   Else
 Image1.Picture = LoadPicture(fn)
 End If
End Sub[/SIZE]
 
PLİNT hocam yardımınız için teşekkür ederim. Kodu kullandım resmi User Form'da bulunan kısıma atıyor ancak dosyadaki 'G' sütununda bulunan kısıma aktarmıyor.
 
Rizelli3' Alıntı:
PLİNT hocam yardımınız için teşekkür ederim. Kodu kullandım resmi User Form'da bulunan kısıma atıyor ancak dosyadaki 'G' sütununda bulunan kısıma aktarmıyor.
Genişletmek için tıkla ...
Merhaba
Ek dosyayı deneyin.
"Resim ekle" ile resmi seçip "Kaydet" ile sayfaya ekleyecektir.

http://s9.dosya.tc/server2/u1r7wc/Ornek_Dosya.zip.html

Kod: 
[SIZE="2"]Private Sub CommandButton2_Click()
Sheets("Kişi Listesi").Activate
   fn = Application.GetOpenFilename(FileFilter:="Resim (*.gif;*.jpg;*.jpeg;*.bmp),*.gif;*.jpg;*.jpeg;*.bmp", _
    Title:="Resim Seç")
    If fn = False Then
MsgBox "Resim seçin"
    Else
 Image1.Picture = LoadPicture(fn)
[COLOR="Red"] Image1.PictureSizeMode = 1[/COLOR]
End If
End Sub [/SIZE]

Kod: 
[SIZE="2"]Private Sub CommandButton1_Click()
Sheets("Kişi Listesi").Activate
Dim Iinsuiv As Integer
If TextBox1 = "" Then MsgBox "İSİM BOŞ BIRAKILAMAZ": Exit Sub
Iinsuiv = [A33358].End(xlUp).Row + 1
Cells(Iinsuiv, 1) = TextBox1.Text
Cells(Iinsuiv, 2) = TextBox2.Text
Cells(Iinsuiv, 3) = ComboBox2.Text
Cells(Iinsuiv, 4) = TextBox4.Text
Cells(Iinsuiv, 5) = TextBox5.Text
Cells(Iinsuiv, 6) = ComboBox1.Text
TextBox1.Text = ""
TextBox2.Text = ""
ComboBox2.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
ComboBox1.Text = ""
TextBox1.SetFocus
Set nesne = ActiveSheet.OLEObjects.Add(classtype:="Forms.Image.1", Width:=78, Height:=41.25)
nesne.Top = Cells(Iinsuiv, "G").Top: nesne.Left = Cells(Iinsuiv, "G").Left
nesne.Height = Cells(Iinsuiv, "G").Height: nesne.Width = Cells(Iinsuiv, "G").Width
[COLOR="Red"]ActiveSheet.OLEObjects(nesne.Name).Object.PictureSizeMode = 1[/COLOR]
ActiveSheet.OLEObjects(nesne.Name).Object.Picture = Me.Image1.Picture
End Sub [/SIZE]
 
Son düzenleme:
PLİNT' Alıntı:
Merhaba
Ek dosyayı deneyin.
"Resim ekle" ile resmi seçip "Kaydet" ile sayfaya ekleyecektir.

http://s9.dosya.tc/server2/u1r7wc/Ornek_Dosya.zip.html

Kod: 
[SIZE="2"]Private Sub CommandButton2_Click()
Sheets("Kişi Listesi").Activate
   fn = Application.GetOpenFilename(FileFilter:="Resim (*.gif;*.jpg;*.jpeg;*.bmp),*.gif;*.jpg;*.jpeg;*.bmp", _
    Title:="Resim Seç")
    If fn = False Then
MsgBox "Resim seçin"
    Else
 Image1.Picture = LoadPicture(fn)
End If
End Sub [/SIZE]

Kod: 
[SIZE="2"]Private Sub CommandButton1_Click()
Sheets("Kişi Listesi").Activate
Dim Iinsuiv As Integer
If TextBox1 = "" Then MsgBox "İSİM BOŞ BIRAKILAMAZ": Exit Sub
Iinsuiv = [A33358].End(xlUp).Row + 1
Cells(Iinsuiv, 1) = TextBox1.Text
Cells(Iinsuiv, 2) = TextBox2.Text
Cells(Iinsuiv, 3) = ComboBox2.Text
Cells(Iinsuiv, 4) = TextBox4.Text
Cells(Iinsuiv, 5) = TextBox5.Text
Cells(Iinsuiv, 6) = ComboBox1.Text
TextBox1.Text = ""
TextBox2.Text = ""
ComboBox2.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
ComboBox1.Text = ""
TextBox1.SetFocus
Set nesne = ActiveSheet.OLEObjects.Add(classtype:="Forms.Image.1", Width:=78, Height:=41.25)
nesne.Top = Cells(Iinsuiv, "G").Top: nesne.Left = Cells(Iinsuiv, "G").Left
nesne.Height = Cells(Iinsuiv, "G").Height: nesne.Width = Cells(Iinsuiv, "G").Width
ActiveSheet.OLEObjects(nesne.Name).Object.Picture = Me.Image1.Picture
End Sub [/SIZE]
Genişletmek için tıkla ...

Hocam elinize kolunuza sağlık Allah razı olsun çok teşekkür ederim.
 
PLİNT hocam çok özür dileyerek bir şey demek istiyorum resmi eklediğimde resmi o kutucuğa sığdırmıyor bi köşesini atıyor resmin resmi kutuya sığdırmamız mümkün müdür.

şimdiden çok teşekkür ederim çok makbule geçti yardımınız.
 
Yukarıdaki (4 no lu mesajda) kodlarda bulunan kırmızı bölümleri ekleyip deneyiniz.
 
PLİNT' Alıntı:
Yukarıdaki (4 no lu mesajda) kodlarda bulunan kırmızı bölümleri ekleyip deneyiniz.
Genişletmek için tıkla ...

Hocam ne desem az çok teşekkür ederim emeğinize sağlık. Son bir şey daha rica edeceğim bu şekilde eklenen resmi silme imkanımız var mı yanlış resim ekledim ama silemiyorum.
 
Son düzenleme:
PLİNT' Alıntı:
Merhaba
Ek dosyayı inceleyin; size daha sonra da gerek olacaktır, ara,bul, sil ve değiştirme yapabilirsiniz.
http://s9.dosya.tc/server2/k1nvnr/Ornek_Dosya2.zip.html
Genişletmek için tıkla ...

PLİNT hocam her şey düşündüğümden daha güzel olmuş ancak gönderdiğiniz örnek dosyada NBNB bölgesini seçtiğimde diğer resim gizlenmiyor oda gözüküyor. Hakkınız ödenmez ama yardımcı olabilir misiniz. Aşağıdaki adrese resim ekledim. Teşekkürler her şey için.

http://s9.dosya.tc/server2/vvou73/Ekran_Alintisi.JPG.html
 
Merhba
Haklısınız "Hücrelerle taşı ve boyutlandır" için kod eklememişiz. Bir kaç ekleme daha yapmaya çalıştım, ek dosyayı deneyin.
Silme işleminde dikkat edeceğiniz nokta resimlerin kodlarla hücreye eklendiği koordinatlardır.
"İmage" hücreden (az bile olsa) ayrıldığında kodlar resmi bulup silemez.

http://s9.dosya.tc/server2/0ozmma/Ornek_Dosya3.zip.html
 
PLİNT' Alıntı:
Merhba
Haklısınız "Hücrelerle taşı ve boyutlandır" için kod eklememişiz. Bir kaç ekleme daha yapmaya çalıştım, ek dosyayı deneyin.
Silme işleminde dikkat edeceğiniz nokta resimlerin kodlarla hücreye eklendiği koordinatlardır.
"İmage" hücreden (az bile olsa) ayrıldığında kodlar resmi bulup silemez.

http://s9.dosya.tc/server2/0ozmma/Ornek_Dosya3.zip.html
Genişletmek için tıkla ...

Hocam ne kadar teşekkür etsem azdır. Allah razı olsun elinize kolunuza sağlık çok teşekkür ederim. İyi ki sizin gibi insanlar var.

iyi çalışmalar hocam.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst