(28/03/2020, 11:47)accessman yazdı: problemin çözülmüş son halini ilk mesaja ekledim

(06/07/2009, 23:57)AccessTr.neT yazdı: 15-) Konu eklendikten sonra, konu başlığının ve/veya mesajınızın tamamını “çözüldü”, “gerek kalmadı”, “iptal” vb. şekilde değiştirmek yasaktır. Konu başlığındaki ve/veya mesajdaki imla hatalarını düzeltebilirsiniz ancak konu başlığının ve/veya mesaj içeriğinin tamamını, sorun çözüldükten sonra da soru içerikli örnek uygulamanızı değiştiremezsiniz. 
İlk ihlalde uyarı puanı verilecektir. 
Uyarı Bitiş Süresi : 6 Ay,
Uyarı Seviyesi +8

Option Compare Database

'" WHERE DateTimeValue >= #" & Format(aDateTimeVariable, "yyyy-mm-dd hh:nn:ss") & "#;"

'" AND Tablo1.bastarih <= #" & Format([sontarih], "dd-mm-yyyy") & "#" & _







Private Sub Komut18_Click()

    Dim strSQL As String

        

    If (sqltur.Value = 1) Then

        strSQL = "SELECT * FROM Tablo1" & _

            " WHERE firma='" & [Metin13] & "'" & _

            " AND not isnull(kronik)" & _

            " AND (CLng(bastarih)<=" & CLng(Me.sontarih) & ")" & _

            " AND (CLng(bittarih)>=" & CLng(Me.ilktarih) & ")"

    Else

        strSQL = " select * from tablo1 where [id] not in ( select [id] from tablo1 where clng(bastarih)>=" & CLng(Me.sontarih) & _

        " or  clng(bittarih)<=" & CLng(Me.ilktarih) & ") and Tablo1.firma='" & [Metin13] & "'"

    End If

    

    listele strSQL, Me.Liste19, 2



End Sub



Private Sub listele(strSQL As String, lst As ListBox, index As Integer)

    On Error Resume Next

    Dim rs As Object

    Dim cn As Object

    Dim scr As Object

    Dim k As Long, kes, i As Long

    

    Set scr = CreateObject("scripting.dictionary")

    scr.CompareMode = TextCompare



    Set rs = CreateObject("ADODB.Recordset")

    Set cn = CreateObject("ADODB.Connection")



    Set cn = CurrentProject.Connection



    With rs

        .CursorType = adOpenDynamic

        .CursorLocation = adUseClient

        .LockType = adLockOptimistic

        .Open strSQL, cn, , , 1

    End With

    

    If rs.RecordCount > 0 Then

        Do While Not rs.EOF

            kes = Split(rs(index), ",")

            For k = LBound(kes) To UBound(kes)

                scr(Trim(kes(k))) = scr(Trim(kes(k))) + 1

            Next

            rs.MoveNext

        Loop

    End If

    

    With lst

        .RowSource = Empty

        If scr.Count < 1 Then GoTo son

        .ColumnCount = 2

        .ColumnWidths = "4Cm;2cm"

    

        For i = 0 To scr.Count - 1

            .AddItem scr.keys()(i) & ";" & scr.items()(i)

        Next

    End With



son:

    rs.Close

    cn.Close

    Set rs = Nothing

    Set cn = Nothing

    Set scr = Nothing

    kes = vbNullString



End Sub