Private Sub Resim186_Click()

' REFERANSLARDAN MİCROSOFT Excel ... OBJECT LİBRARY TANIMLAMINIZ GEREKİYOR..

Dim Exapp As Excel.Application

Dim objWsh As Object

Dim rs As Recordset

Dim yol As String

Dim X As Long

Dim r As Range

Dim GTarih As String

Dim qdf As QueryDef

Dim intMaxCol As Integer

Dim intMaxRow As Integer

Dim m, n, o, a As Variant

n = [Forms]![indexform]![GezintiAltFormu].[Form]![tur]

o = [Forms]![indexform]![GezintiAltFormu].[Form]![sekil]

m = [Forms]![indexform]![GezintiAltFormu].[Form]![amir]

If [Forms]![indexform]![GezintiAltFormu].[Form]![amir] <> "" Or [Forms]![indexform]![GezintiAltFormu].[Form]![amir] <> Null Then

a = [Forms]![indexform]![GezintiAltFormu].[Form]![amir]

Else

a = " takviyeler"

End If

Set Exapp = GetObject("", "excel.application")

If Err.Number <> 0 Then

  Err.Clear

        Set Exapp = CreateObject("Excel.Application")

End If

'exel yol tanımlıyoruz..

yol = CurrentProject.Path & "\deneme.xlsx"

'exceli açarak yükler.. false derseni.. exceli açmadan yükler.. size kalmış

Exapp.Visible = True

Exapp.Workbooks.Open yol



GTarih = Date

For Each objWsh In Exapp.Worksheets

        If objWsh.Name = GTarih Then

        Exapp.Worksheets(GTarih).Delete

        End If

Next

Exapp.Visible = True



Exapp.Sheets("Sayfa1").Copy Before:=Exapp.Sheets(1)

Exapp.ActiveSheet.Name = Date & "  " & a & " " & n



'eski Excel verileri siliyoruz...

With Exapp

        

          .Range("B14:N38").ClearNotes

          .Range("V14:P38").ClearNotes

          .Range("V14:V38").ClearNotes

End With

Exapp.Visible = True



'sorgu açılıyor...



Set qdf = CurrentDb.QueryDefs("iase_yolluk_sorgu")





qdf![Formlar!indexform!GezintiAltFormu.Form!amir] = m

qdf![Formlar!indexform!GezintiAltFormu.Form!tur] = n

qdf![Formlar!indexform!GezintiAltFormu.Form!sekil] = o



Set rs = qdf.OpenRecordset()



'intMaxCol = rs.Fields.Count

'Set rs = CurrentDb.OpenRecordset("iase_yolluk_sorgu")

'intMaxRow = rs.RecordCount



X = 14

Do While Not rs.EOF



With Exapp

    .Cells(X, 2) = rs("olursicil")          '2 B KOLONUDUR

    .Cells(X, 3) = rs("olurisim")

    .Cells(X, 4) = rs("MaasD")

  .Cells(X, 5) = "/"

    .Cells(X, 6) = rs("MaasK")

    .Cells(X, 7) = rs("rutbe2")

    .Cells(X, 8) = rs(Format("olurtarih1", "dd.mm.yyyy"))

  

    .Cells(X, 10) = rs("olurtarih2")

    .Cells(X, 12) = rs("GÜNÜ")

    .Cells(X, 13) = rs("GUNDELİK")

      .Cells(X, 14) = rs("t1")

      

      .Cells(X, 16) = rs("oluryeri")

      .Cells(X, 22) = rs("t1")

    

    

    

End With

rs.MoveNext

X = X + 1

Loop



rs.Close

End Sub

merhabalae, Ozan hocamın yardımlarıyla bu şekilde son haline gelmiş bir excele aktarma butonum var.    şablona aktarıyor. şablonda 25 kayıtlık bir alan var. acaba bu 25 kayıtlık alanı şablondan 1 e düşürsem.  Kayıt eklerken aynı biçimde yani satır eklese kayıt sayısı kadar eklese olurmu. maxrow ve maxcol ile bişeyler denedim ama beceremedim veya çok karmaşık yazdırdı. Yardımcı olabilirmisiniz.