AccessTr.neT

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.

Hocam  Konuyu Silmeyi Bulamadım Size zahmet olmazsa silebilirmisiniz. boş yere kalabalık etmesin

sorunu çözebildiniz mi?
çözebildiyseniz cevabı paylaşmanız mümkün mü?
iyi çalışmalar

Hocam Çözemedim ama  çok sık soru sorduğum için örnekte atamadım. birde yanlış şeyler yapmış gibi hissettim silinirse uygun olur diye düşündüm. Sonuçta Sizde hizmet veriyorsunuz birçok kişiye, gerçekten acceste bir numarasınız.  Kamu kurumlarının bilgisayararı genelde c#  oracle vs izin vermiyor. accessi içerisinde Vba ve sorgular olması gerçekten çok kullanışlı yapmış. Kamu kurumlarının ihtiyaçalrına cevap verebiliyor.  bu konuda emin olun bir numarasınız Türkiyede. Bu sebeple çok yoruyoruz sizi. Kusurmuza bakmayın.

örnek kodları inceledim, ancak çözüm bulmak için örnek uygulamanız gerekli, uygulamanızı ekleyin kodları inceleyip çözüm arayalım.