Giüncel ve hızlı çalışan dosya ektedir.
Class kodlar;
Option Compare Database
Public WithEvents opt As ListView
Dim adbulLstvew
Private Sub Class_Terminate()
Set opt = Nothing
End Sub
Private Sub opt_ItemClick(ByVal Item As MSComctlLib.ListItem)
veri = opt.SelectedItem
End Sub
Private Sub opt_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Form_Form2.güncelle adbul, veri
End Sub
Public Property Get adbul() As Variant
adbul = adbulLstvew
End Property
Public Property Let adbul(ByVal Value As Variant)
adbulLstvew = Value
End Property
Form Kodlar;
Option Compare Database
Private Kontrol As New Collection
Const ii As Byte = 20
Public Sub FillEmployees(ad As String)
On Error GoTo ErrorHandler
'set variables
Dim rst As New ADODB.Recordset
Dim lstItem As ListItem
Dim strSQL As String
strSQL = "SELECT * FROM Tablo2 WHERE id1=" & Format(Right(ad, 2), "00")
rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
With Me(ad)
'Set ListView style
.View = lvwReport
'This is not supported by ListView 5
.GridLines = True
.FullRowSelect = True
'Clear Header and ListItems
.ListItems.Clear
.ColumnHeaders.Clear
End With
'Set up Column headers
With Me(ad).ColumnHeaders
.Add , , "id", 0, lvwColumnLeft
.Add , , "Adı Soyadı", 2000, lvwColumnLeft
.Add , , "Görevi", 2600, lvwColumnLeft
End With
' Add items and subitems to list control.
rst.MoveFirst
If rst.EOF <> True Then
Do
Set lstItem = Me(ad).ListItems.Add()
lstItem.Text = rst!ID
lstItem.SubItems(1) = Nz(rst!adisoyadi)
lstItem.SubItems(2) = Nz(rst!görevi)
rst.MoveNext
Loop Until rst.EOF
End If
'close recordset
rst.Close
DoCmd.Echo True
ErrorHandlerExit:
Set rs = Nothing
Exit Sub
ErrorHandler:
If Err = 3021 Then ' no current record
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End If
rst.Close
Set rs = Nothing
strSQL = vbNullString
End Sub
Private Sub Form_Current()
Dim ctl As Variant
Dim i As Variant
Dim TxtOpt As ClsLstvew
For i = 0 To ii
Set TxtOpt = New ClsLstvew
Select Case i
Case 0
TxtOpt.adbul = Me.Controls("L00").Name
Set TxtOpt.opt = Controls("L00").Object
Case 1 To 9
TxtOpt.adbul = Me.Controls("L0" & i).Name
Set TxtOpt.opt = Controls("L0" & i).Object
Case Else
TxtOpt.adbul = Me.Controls("L" & i).Name
Set TxtOpt.opt = Controls("L" & i).Object
End Select
Kontrol.Add TxtOpt
Next
For i = 0 To ii
Call FillEmployees("L" & Format(i, "00"))
Next
DoCmd.Maximize
End Sub
Private Sub Komut43_Click()
DoCmd.Quit
End Sub
Public Function güncelle(asd As String, ByVal asde As Integer)
Dim i As Variant
Dim rstkayit As New ADODB.Recordset
Dim strSQL As String
strSQL = "UPDATE Tablo2 SET id1 =" & Right(asd, 2) & " WHERE id =" & asde & ";"
CurrentProject.Connection.Execute strSQL
For i = 0 To ii
Call FillEmployees("L" & Format(i, "00"))
Next
End Function
Modül kod;
Option Compare Database
Public veri As String
Class Listview sürükle kisa kod.rar
(Dosya Boyutu: 71,91 KB | İndirme Sayısı: 3)
