DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub ListBox1_Click()
Dim i As Byte, yol As String
If ListBox1.ListCount = 0 Then Exit Sub
For i = 1 To 8
Me.Controls("TextBox" & i).Value = ListBox1.Column(i - 1)
Next i
yol = ThisWorkbook.Path
dosya = ListBox1.Column(2) & ".jpg"
On Error Resume Next
Image1.Picture = LoadPicture("")
Image1.Picture = LoadPicture(yol & "\" & dosya)
End Sub
Rica ederim.Sn. Evren Gizlen ve Sn. fedeal ,
İlgi ve bilgilerinize minnettarım . Allah (CC) emeklerinden razı olsun, ecrinizi arttırsın .
Saygılarımla...
Private Sub ListBox1_Click()
If ListBox1.ListCount = 0 Then Exit Sub
For j = 1 To 8
Me.Controls("TextBox" & j).Value = ListBox1.Column(j - 1)
Next j
UserForm1.Image1.Picture = LoadPicture(None)
For i = 1 To 10
resimyükle = ThisWorkbook.Path & "\" & ListBox1.Column(2) & "." & resimuzantısı(Val(i))
On Error Resume Next
UserForm1.Image1.Picture = LoadPicture(resimyükle)
Next i
If UserForm1.Image1.Picture = LoadPicture(None) Then
UserForm1.Image1.Visible = False
Else
UserForm1.Image1.Visible = True
End If
End Sub
Function resimuzantısı(Sayi#)
Dim yazi As String
Dim b As Integer
ReDim birler$(5000), onlar$(1), basamak$(5)
birler$(1) = "bmp": birler$(2) = "jpg"
birler$(3) = "gif": birler$(4) = "pcx"
birler$(5) = "tga": birler$(6) = "xls"
birler$(7) = "abm": birler$(7) = "avi"
birler$(8) = "exe": birler$(9) = "doc"
GoSub cevir
resimuzantısı = birler$(Sayi) 'cevap
If Sayi = 0 Then
resimuzantısı = "jpg"
End If
Exit Function
cevir:
cevap = birler$(Sayi)
Return
End Function
Dosyanız ekte.Hocam ,
Filimleri hangi DVD de, hangi filim var diye Excel sayfasından takip ediyorum. Desteğinizle artık işim daha kolay. serdarinho43 arkadaşın dediği gibi bul butonu veya git dediğimde filim adını yazınca listbox o filimi göstersin, eklememiz münkün mü?
Saygılar..
Function liste(deg As String)
Dim k As Range, myarr(), a As Long, j As Byte, adr As String
ReDim myarr(1 To 8, 1 To 1)
With Sheets("YABANCI")
Set k = .Range("C2:C" & .Cells(65536, "C").End(xlUp).Row).Find("*" & deg & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adr = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 8, 1 To a)
For j = 1 To 8
myarr(j, a) = .Cells(k.Row, j).Value
Next j
Set k = .Range("C2:C" & .Cells(65536, "C").End(xlUp).Row).FindNext(k)
Loop While Not k Is Nothing And k.Address <> adr
End If
End With
liste = myarr
End Function
Rica ederim.Üstadım , saygı ve hürmetlerimle ...
Teşekkürler ...
Sanırım dosyayı eklersem daha ii açıklayabilirim bul butonuna bastığımda ilgili resimin image e gelmesini istiyorum aynı istem listboxta ilgili kişiyi seçtiğimdede gerçeklerşsin
Resim yükle butonunu ekledim burdaki amacım yeni bir kişi eklediğimde dosyayı açmadan direk bu butonla sistem dosyasına kişinin resmini eklemek istiyorum bunu yapabilir miyim?
hepinize şimdiden teşekkürler
Aynı dosyayla ilgili açılmış öteki konuda işinize yarayacak bir çalışma mevcut
11.mesajda
http://www.excel.web.tr/showthread.php?t=74285&page=2
Private Sub ComboBox1_Change()
On Error Resume Next
Set ARA = Sheets("1").Range("a:a").Find(ComboBox1)
If Not ARA Is Nothing Then
Image1.Picture = LoadPicture("")
Image1.Picture = LoadPicture(Sheets("1").Cells(ARA.Row, "bc").Value)
End If
End Sub
Private Sub CommandButton14_Click()
ChDir ("C:\")
dosya = Application.GetOpenFilename(FileFilter:="," & _
"*.jpg", _
Title:="Lütfen resim seçimi yapınız") ' uzantı eklemeleri yapabilirsiniz
If dosya = False Then ' eğer vazgeçe basarsanız
'MsgBox "Dosya seçme işleminden vazgeçildi", , "KodGenTRKN"
Exit Sub
Else
Image1.Picture = LoadPicture("")
Set ARA = Sheets("1").Range("a:a").Find(ComboBox1)
If Not ARA Is Nothing Then
Sheets("1").Cells(ARA.Row, "bc").Value = yol & dosya & uzanti
Image1.Picture = LoadPicture(yol & dosya & uzanti)
End If
End If
End Sub