Excele Gönderirken Biçimlendirme Sorunu

Merhaba arkadaşlar,
form üzerinden excele gönder yapıyorum,
iplik noların bir kısmı hatalı gözüküyor,
12/2 ===>>> 2.Ara olarak gözüküyor,

Set vbSheet = vbBook.Worksheets(1) satırı ile vbSheet.Cells.Select satırlarının arasını değiştirip dener msiniz?

Set vbSheet = vbBook.Worksheets(1)

' vbExcel.Visible = True

Dim fdArray, fdCount, rdCount

fdCount = 0

For Each fdExcel In rsExcel.Fields

fdCount = fdCount + 1

    If fdCount > 1 Then

    fdArray = fdArray & "<,>" & fdExcel.Name

    Else

    fdArray = fdExcel.Name

    End If

Next

 

' Excel Belgesine Başlıklar Aktarılıyor

With vbSheet.Range("A1")

.Resize(1, fdCount) = Split(fdArray, "<,>")

.Resize(1, fdCount).Font.Color = &HFF0000

.CopyFromRecordset rsExcel

End With

 



vbSheet.Cells.Select

(23/06/2022, 15:24)berduş yazdı: Set vbSheet = vbBook.Worksheets(1) satırı ile vbSheet.Cells.Select satırlarının arasını değiştirip dener msiniz?

Set vbSheet = vbBook.Worksheets(1)

' vbExcel.Visible = True

Dim fdArray, fdCount, rdCount

fdCount = 0

For Each fdExcel In rsExcel.Fields

fdCount = fdCount + 1

    If fdCount > 1 Then

    fdArray = fdArray & "<,>" & fdExcel.Name

    Else

    fdArray = fdExcel.Name

    End If

Next

 

' Excel Belgesine Başlıklar Aktarılıyor

With vbSheet.Range("A1")

.Resize(1, fdCount) = Split(fdArray, "<,>")

.Resize(1, fdCount).Font.Color = &HFF0000

.CopyFromRecordset rsExcel

End With

 



vbSheet.Cells.Select

önceki:


şimdiki: başlıklar gelmedi

kusura bakmayın yanlışlıkla A2 yerine A1 yazmışım kodu aşağıdaki gibi düzenleyip dener misiniz?
ilk ' Excel Belgesine Başlıklar Aktarılıyor ile vbExcel.Quit arası alındı bu satırlar da dahil

' Excel Belgesine Başlıklar Aktarılıyor

Set vbSheet = vbBook.Worksheets(1)



For Each fld In rsExcel.Fields

    x = x + 1

    vbSheet.Cells(1, x) = fld.Name

Next fld



vbSheet.Range("A1").Resize(1, x).Font.Color = &HFF0000

vbSheet.Range("A2").CopyFromRecordset rsExcel



vbSheet.Range("A1").Select

vbSheet.Cells.EntireColumn.AutoFit

 

vbBook.SaveAs "D:\Desktop\Dokumaya Gönderilen-" & Date & ".xlsx"

vbExcel.Quit

sn halil üstadım, çok teşekkür ederim,
Allah razı olsun,

Dilerim

vbSheet.Range("A2").CopyFromRecordset rsExcel

satırına dikkat etmişsinizdir
Recordsetten veriyi satır satır eklemenize gerek yok
Bu yöntemle tümünü birden aktarabiliyorsunuz