AccessTr.neT

Tam Versiyon: Excele Gönderirken Biçimlendirme Sorunu
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
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,


[Resim: do.php?img=12365]
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:
[Resim: do.php?img=12367]

şimdiki: başlıklar gelmedi
[Resim: do.php?img=12368]
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