Skip to main content

AccessTr.neT


Access Raporu Göründüğü Gibi Excele Aktarma

Akın Yıldız Usta
Akın Yıldız Usta
1
686

Access Raporu Göründüğü Gibi Excele Aktarma

Çözüldü #1
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.
.rar excele aktarma.rar (Dosya Boyutu: 24,97 KB | İndirme Sayısı: 8)
Cevapla
#2
"Excele Aktar" butonunu kodunu aşağıdaki gibi düzenleyip dener misiniz?
not: Referanslardan ==> Microsoft Excel x.x Object Library nin seçilmesi gerekmektedir. <==
Visual Basic Code
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:D3").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 & ":D" & 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
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da