MERHABALAR BEN ACCESSTE BULUNAN RAPORUMU EXCELE AKTARMAK İSTİYORUM.FAKAT AKTAR DEDİĞİM ZAMAN ECXELDE VERİLER YAN YANA YERLEŞİYOR. BENİM İSTEDİĞİM RAPORDA NASIL GÖRÜNTÜLÜYORSAM EXCELE DE O ŞEKİLDE AKTARMAK. ÖRNEK EKLEDİM.
ŞİMDİDEN TEŞEKKÜRLER.
"Excele Aktar" butonunu kodunu aşağıdaki gibi düzenleyip dener misiniz?
not: Referanslardan ==> Microsoft
Excel x.x Object Library nin seçilmesi gerekmektedir. <==
Dim Excl As Object
Dim rs As Recordset
Dim KTP As Workbook
Dim SYF As Worksheet
Dim i%: i = 4 '........Sayac........
Set Excl = New Excel.Application '...Yeni Excel ....
With Excl
.Application.Visible = True '...Excel uygulamasi gorunur....
.UserControl = True
End With
Set KTP = Excl.Workbooks.Add '....Kitap ekle....
Set SYF = KTP.Worksheets(1) '....Sayfa olustur....
'....BASLIKLAR.........
SYF.Cells(1, 1) = "DAVETLİ LİSTESİ"
SYF.Range("A1:I1").Merge
SYF.Cells(2, 1) = "S/N"
SYF.Range("A2:A3").Merge
SYF.Cells(2, 2) = "Tc"
SYF.Range("B2:B3").Merge
SYF.Cells(2, 3) = "Adı"
SYF.Range("C2:C3").Merge
SYF.Cells(2, 4) = "Soy Adı"
SYF.Range("D2
3").Merge
SYF.Cells(2, 5) = "Davetlilerin"
SYF.Range("E2:H2").Merge
SYF.Cells(2, 9) = "Araç Sayısı"
SYF.Range("I2:I3").Merge
SYF.Cells(3, 5) = "Yakınlık Derecesi"
SYF.Cells(3, 6) = "Adı Soyadı"
SYF.Cells(3, 7) = "Yakınlık Derecesi"
SYF.Cells(3, 8) = "Adı Soyadı"
Set rs = CurrentDb.OpenRecordset("Tablo1") '.....Tablo Okunuyor............
i = i '+ 1 '.... Sayac bir ilerletiliyor, ayni satira yazmasin diye....
sn = 0
Do Until rs.EOF '.....Tablo kayitlari sonuna kadar oku ......
sn = sn + 1
SYF.Cells(i, "A") = sn
SYF.Range("A" & i & ":A" & i + 2).Merge
SYF.Cells(i, "B") = rs(1)
SYF.Range("B" & i & ":B" & i + 2).Merge
SYF.Cells(i, "C") = rs(2)
SYF.Range("c" & i & ":c" & i + 2).Merge
SYF.Cells(i, "D") = rs(3)
SYF.Range("D" & i & "" & i + 2).Merge
SYF.Cells(i, "E") = rs(4)
SYF.Cells(i, "f") = rs(5)
SYF.Cells(i + 1, "e") = rs(6)
SYF.Cells(i + 1, "f") = rs(7)
SYF.Cells(i + 2, "e") = rs(8)
SYF.Cells(i + 2, "f") = rs(9)
SYF.Cells(i, "g") = rs(10)
SYF.Cells(i, "h") = rs(11)
SYF.Cells(i + 1, "g") = rs(12)
SYF.Cells(i + 1, "h") = rs(13)
SYF.Cells(i + 2, "g") = rs(14)
SYF.Cells(i + 2, "h") = rs(15)
SYF.Cells(i, "I") = rs(16)
i = i + 3 '.... Sayac bir ilerletiliyor, ayni satira yazmasin diye....
rs.MoveNext '.....Tablo kaydin sonraki satirina git.............
Loop '.....Dongu sonu Do sonrasina git..............
rs.Close '.....Okuma bittiginde tabloyu kapat.......
SYF.UsedRange.HorizontalAlignment = xlCenter 'yatay hizalama
SYF.UsedRange.VerticalAlignment = xlCenter
SYF.UsedRange.Columns.AutoFit
With SYF.UsedRange.Borders
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThick
End With
SYF.Range("A1:I3").Font.Color = vbRed
Set Excl = Nothing