(25/10/2018, 10:49)ozanakkaya yazdı: Merhaba. Örnek uygulama olmadan çözüm yazmak farazi.Form için kullandığım VB script aşağıdaki gibidir. Veri tabanım iki form dan oluşmakta. Birisi (Asel1) veri aramak için kriterleri girdiğim form ki VB scrit i aşağıdaki gibidir. Diğeri de veri girmek için kullandığım form (Asel2)
Kritere göre listeleme yaptırabiliyorsanız sorgunuzda ölçüt olayı var. Aynı soruyu raporun kayıt kaynağı olarak kullanın.
Yüklediğim resimde Asel1 formumun yapısını gösterdim. Saygılarımla
Kod:
Aasel1 Form VB Scrip
Option Compare Database
Option Explicit
Private Sub cmdFilter_Click()
Dim strWhere As String
Dim lngLen As Long
Const conJetDate = "\#dd\/mm\/yyyy\#"
If Not IsNull(Me.txtFilterLokasyon) Then
strWhere = strWhere & "([Lokasyon] Like ""*" & Me.txtFilterLokasyon & "*"") AND "
End If
If Not IsNull(Me.txtFilterSatinalimTarihi) Then
strWhere = strWhere & "([SatinalimTarihi] Like ""*" & Me.txtFilterSatinalimTarihi & "*"") AND "
End If
If Not IsNull(Me.txtFilterNeOldugu) Then
strWhere = strWhere & "([NeOldugu] Like ""*" & Me.txtFilterNeOldugu & "*"") AND "
End If
If Not IsNull(Me.txtFilterKullaniciAdi) Then
strWhere = strWhere & "([KullaniciAdi] Like ""*" & Me.txtFilterKullaniciAdi & "*"") AND "
End If
If Not IsNull(Me.txtFilterMasrafYeriKodu) Then
strWhere = strWhere & "([MasrafYeriKodu] Like ""*" & Me.txtFilterMasrafYeriKodu & "*"") AND "
End If
If Not IsNull(Me.txtFilterSeriNo) Then
strWhere = strWhere & "([SeriNo] Like ""*" & Me.txtFilterSeriNo & "*"") AND "
End If
If Not IsNull(Me.txtFilterUreticisi) Then
strWhere = strWhere & "([Ureticisi] Like ""*" & Me.txtFilterUreticisi & "*"") AND "
End If
If Not IsNull(Me.txtFilterModelNo) Then
strWhere = strWhere & "([ModelNo] Like ""*" & Me.txtFilterModelNo & "*"") AND "
End If
'If Not IsNull(Me.txtStartDate) Then
' strWhere = strWhere & "([EnteredOn] >= " & Format(Me.txtStartDate, conJetDate) & ") AND "
' End If
'If Not IsNull(Me.txtEndDate) Then
' strWhere = strWhere & "([EnteredOn] < " & Format(Me.txtEndDate + 1, conJetDate) & ") AND "
' End If
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then
MsgBox "Bilgi ile ilgili en az bir kriter giriniz!!", vbInformation, "Lütfen Dikkat!!"
Else
strWhere = Left$(strWhere, lngLen)
Me.Filter = strWhere
Me.FilterOn = True
End If
End Sub
Private Sub cmdReset_Click()
Dim ctl As Control
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
ctl.Value = Null
Case acCheckBox
ctl.Value = False
End Select
Next
Me.FilterOn = False
End Sub
Private Sub Command166_Click()
Me.Refresh
End Sub
Private Sub Form_Activate()
Me.Refresh
End Sub
Private Sub Form_BeforeInsert(Cancel As Integer)
Cancel = True
MsgBox "You cannot add new clients to the search form.", vbInformation, "Permission denied."
End Sub
Private Sub Command64_Click()
On Error GoTo Err_Command64_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "frmAsel2"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Command64_Click:
Exit Sub
Err_Command64_Click:
MsgBox Err.Description
Resume Exit_Command64_Click
End Sub
Private Sub add_data_Click()
On Error GoTo Err_add_data_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "frmAsel2"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_add_data_Click:
Exit Sub
Err_add_data_Click:
MsgBox Err.Description
Resume Exit_add_data_Click
End Sub
Private Sub Text128_Click()
On Error GoTo Err_Form_Current
Dim rst As Recordset
Set rst = Me.RecordsetClone
rst.Bookmark = Me.Bookmark
Me.txtPosition = rst.AbsolutePosition + 1
Exit_Form_Current:
Set rst = Nothing
Exit Sub
Err_Form_Current:
If Err = 3021 Then 'No current record
Me.txtPosition = rst.RecordCount + 1
Else
MsgBox Error$, 16, "Error in Form_Current()"
End If
Resume Exit_Form_Current
End Sub
Private Sub txtPosition_Click()
End Sub