Dim XlAc As Excel.Application
Dim XlKtp As Excel.Workbook
Dim XlSyf As Excel.Worksheet
Dim xRng As Excel.Range
burada tanımlama tüm nesneleri as object olarak değiştirip dener misiniz?
Dim XlAc As object
Dim XlKtp As object
Dim XlSyf As object
Dim xRng As object
gibi
Günaydın sayın berduş, sorun düzeldi sürüm farkından dolayı hata veriyordu. Katkılarınızdan dolayı teşekkür eder saygılarımı sunarım. İyi çalışmalar.
Sayın berduş hocam öncelikle saygılarımı sunar iyi çalışmalar dilerim. Yardımlarınızla yukarıdaki konuyu çözüme kavuşturduk. Kod aşağıdaki gibi. Ek olarak exccele aktarım yaparken excceldeki eski verileri nasıl sileriz. Yani sorgu sunucu boşsa excelleki eski kayıtlarıda silsin.Nasıl bir ekleme yapabiliriz. Saygılarımla iyi çalışmalar.
Private Sub Komut10_Click() 'POZİTİF
Dim TabloAdi As String
Dim XlAd As String
Dim SyfAd As String
TabloAdi = "Srg_covit_EXCELL_POZATİF"
XlAd = CurrentProject.Path & "\Şablon.xlsx"
SyfAd = "POZİTİF" '& "$"
'hy Excele sayfasına verileri biçimli aktarma_____________________________
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim StrAna As String
Set dbs = CurrentDb
StrAna = "SELECT [t_tcno],[AdıSoyadı],[t_mudrlük],[t_gorevyeri],[Yaşı],[t_ilce],[t_hastaneadi],[t_telefon] FROM Srg_covit_EXCELL_POZATİF" 'ya alanların ismi tek tek yazılacak yada _
sadece gerekli alanların olduğu bir sorgu oluşturup oradan select * diyeceksiniz
Set rsSQL = dbs.OpenRecordset(StrAna, dbOpenSnapshot)
If rsSQL.RecordCount > 0 Then
rsSQL.MoveLast
rsSQL.MoveFirst
Else
Exit Sub
End If
'hy Exceli aç
Dim XlAc As Excel.Application
Dim XlKtp As Excel.Workbook
Dim XlSyf As Excel.Worksheet
Dim xRng As Excel.Range
Dim SonStr As Long
Set XlAc = CreateObject("Excel.Application")
Set XlKtp = XlAc.Workbooks.Open(XlAd)
Set XlSyf = XlKtp.Worksheets(SyfAd)
XlAc.Visible = False
SonStr = XlSyf.Cells(XlSyf.Rows.Count, 2).End(xlUp).row + 1 'XlAc.UsedRange.Rows(XlAc.UsedRange.Rows.Count).row
Debug.Print SonStr
XlSyf.Range("B2:Z" & SonStr).ClearContents
XlSyf.Range("B2").CopyFromRecordset rsSQL
rsSQL.Close
Set rsSQL = Nothing
'XlSyf.Range("A1").CurrentRegion.Select
Set xRng = XlAc.Selection
With xRng
' .Columns.AutoFit
' .Borders.LineStyle = xlContinuous
.BorderAround LineStyle:=xlContinuous ', Weight:=xlThick
End With
'' İsterseniz aşağıdaki satırı da aktifleştrebilirsiniz
XlKtp.Save
XlAc.Quit
Set XlAc = Nothing
Set XlKtp = Nothing
Set XlSyf = Nothing
'''Set xRng = Nothing
(11/09/2020, 11:10)orderyazbim yazdı: [ -> ]XlSyf.Range("B2:Z" & SonStr).ClearContents
Bu kod silmek için kullanılmıştı. Bunu kullanarak silebilirsiniz
Sayın hocam çok teşekkür eder saygılarımı sunarım.İyi çalışmalar....