sbayyigit
Altın Üye
- Katılım
- 11 Aralık 2004
- Mesajlar
- 415
- Excel Vers. ve Dili
- Ms Office Pro Plus 2019
- Altın Üyelik Bitiş Tarihi
- 23-02-2026
Arkadaşlar veritabanı sayfasındaki listeden seçeceğim kişiler lstpersonel listesinde sıralanıyor. bu listeden seçeceğim kişiye ve izinler sayfasında kayıtlı olan kullandığı izinleri listbox1 içerisine sıralamak istiyorum. ama nedense yapamadım. daha önce bu forumdaki arkadaşlar yardım etmiş ve bu şekilde çalışmıştı ama şimdi çalıştıramıyorum. sorun nerde acaba?
Private Sub lstpersonel_Click()
On Error Resume Next
Sheets("veritabani").Select
Columns("B:B").Select
adi.Value = lstpersonel.Value
Selection.Find(adi.Value, ActiveCell).Activate
'adi.Value = ActiveCell.Offset(0, 0)
gorevi.Value = ActiveCell.Offset(0, 2)
sicil.Value = ActiveCell.Offset(0, 3)
tc.Value = ActiveCell.Offset(0, 4)
Kadro.Value = ActiveCell.Offset(0, 5)
karne.Value = ActiveCell.Offset(0, 6)
tel.Value = ActiveCell.Offset(0, 8)
'hasta.Value = ActiveCell.Offset(0, 8)
miktar.Value = ActiveCell.Offset(0, 12)
Dim Hucre As Range
Dim Satir As Integer
With listbox1
.Clear
.ColumnCount = 4
.ColumnWidths = "55;30;50;20"
Satir = 0
For Each Hucre In Worksheets("izinler").Range("C1:C")
If Hucre.Value = lstpersonel.List(lstpersonel.ListIndex) Then
.AddItem
.List(Satir, 0) = Hucre.Offset(0, 1)
.List(Satir, 1) = Hucre.Offset(0, 3)
.List(Satir, 2) = Hucre.Offset(0, 4)
.List(Satir, 3) = Hucre.Offset(0, 2)
Satir = Satir + 1
End If
Next Hucre
End With
hata:
If Err = 91 Then
cevap = MsgBox(adi.Value & " isimli kişiye ait hiçbir kayıt bulunamadı. Lütfen yazdığınız adı kontrol ediniz.", vbOKOnly, "Personel İzin Programı")
cevap = vbOK
adi.Value = ""
End If
End Sub
Private Sub lstpersonel_Click()
On Error Resume Next
Sheets("veritabani").Select
Columns("B:B").Select
adi.Value = lstpersonel.Value
Selection.Find(adi.Value, ActiveCell).Activate
'adi.Value = ActiveCell.Offset(0, 0)
gorevi.Value = ActiveCell.Offset(0, 2)
sicil.Value = ActiveCell.Offset(0, 3)
tc.Value = ActiveCell.Offset(0, 4)
Kadro.Value = ActiveCell.Offset(0, 5)
karne.Value = ActiveCell.Offset(0, 6)
tel.Value = ActiveCell.Offset(0, 8)
'hasta.Value = ActiveCell.Offset(0, 8)
miktar.Value = ActiveCell.Offset(0, 12)
Dim Hucre As Range
Dim Satir As Integer
With listbox1
.Clear
.ColumnCount = 4
.ColumnWidths = "55;30;50;20"
Satir = 0
For Each Hucre In Worksheets("izinler").Range("C1:C")
If Hucre.Value = lstpersonel.List(lstpersonel.ListIndex) Then
.AddItem
.List(Satir, 0) = Hucre.Offset(0, 1)
.List(Satir, 1) = Hucre.Offset(0, 3)
.List(Satir, 2) = Hucre.Offset(0, 4)
.List(Satir, 3) = Hucre.Offset(0, 2)
Satir = Satir + 1
End If
Next Hucre
End With
hata:
If Err = 91 Then
cevap = MsgBox(adi.Value & " isimli kişiye ait hiçbir kayıt bulunamadı. Lütfen yazdığınız adı kontrol ediniz.", vbOKOnly, "Personel İzin Programı")
cevap = vbOK
adi.Value = ""
End If
End Sub