Kodları tek tek kopyalayınız.

Alttaki işaretli olanlarda seçili olmalı.

Option Compare Database



Dim Sql As String

Dim rs As New ADODB.Recordset

Dim cn As New ADODB.Connection

Dim rs1 As New ADODB.Recordset

Sub loopTable(alan As Byte)



Dim k As Integer



    With rs

    If Not .BOF And Not .EOF Then

        For i = 1 To .RecordCount

          .AddNew

            .Fields(1) = rs1.Fields(1)

            .Fields(2) = alan

            For k = 3 To rs.Fields.Count - 1

              .Fields(k) = rs1.Fields(k)

            Next k

          rs.Update

          rs.MoveNext

          rs1.MoveNext

      Next i

  

    End If

    End With



End Sub

Sub baglan()

  With rs

        If .State = adStateOpen Then .Close

          .CursorLocation = adUseClient

          .CursorType = adOpenKeyset

          .LockType = adLockOptimistic

        

        .Open Sql, cn

    End With



    With rs1

        If .State = adStateOpen Then .Close

          .CursorLocation = adUseClient

          .CursorType = adOpenKeyset

          .LockType = adLockOptimistic

        .Open Sql, cn

    End With

End Sub

Private Sub Aktar_Click()

  

  If Me.cmbay1.Value = "" Or IsNull(cmbay1.Value) Then GoTo son

    If cmbay2.Value = "" Or IsNull(cmbay2.Value) Then GoTo son

  

  Sql = "SELECT * FROM hesap where ay_id= " & cmbay1.Column(0) & ""

  Set cn = CurrentProject.Connection

    

  Call baglan

  Call loopTable(cmbay2.Column(0))



  

  Sql = "SELECT * FROM hesap where ay_id= " & cmbay2.Column(0) & ""

  rs.Close

  rs.Open Sql, cn

  

    Liste15.ColumnCount = rs.Fields.Count ' rs.Fields.Count

    Liste15.ColumnWidths = "1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM"

    Liste15.ColumnHeads = True



    Set Liste15.Recordset = rs

    rs.Close

    cn.Close

    Set rs = Nothing

    Set cn = Nothing



    Set rs1 = Nothing

    Set cn1 = Nothing



  Exit Sub

    

son:

  MsgBox "Combolar bos olamaz", vbCritical

End Sub