Veritabanından matbu liste olşturma

[METİN580]

Merhaba Arkadaşlar,

Excelde tablo halinde 100 satırın üzerinde yer verilerinin wordde veya excel de matbu formatlı bir listeye aktarmam gerekiyor.
yardımcı olabilirseniz çok sevinirim, şimdiden teşekkürler

 

[Orion1]

Merhaba Arkadaşlar,

Excelde tablo halinde 100 satırın üzerinde isim-soyad-yer verilerinin wordde veya excel de matbu formatlı bir listeye aktarmam gerekiyor.
yardımcı olabilirseniz çok sevinirim, şimdiden teşekkürler

Yardımcı olacak arkadaşlar mutlaka çıkacaktır.Ama nasıl yardımcı olacaklar!Siz onların size yardımcı olabilmeleri için ne gibi bir hazırlık yaptınız?

 

[METİN580]

upload tamam

 

[Orion1]

upload tamam

Dosyanızı 2003 formatında eklerseniz daha çabuk yardım alabilirsiniz.
Ziraa henüz herkeste 2007 yok.!

 

[METİN580]

arkadaşlar dosyaları 2003 formatında ekledim.

 

[Orion1]

Dosyanız ektedir.

Sub matbuu_59()
Dim sh As Worksheet, sat As Long, i As Long, sat2 As Byte
Dim say As Long, say2 As Long, sat1 As Long
Sheets("Matbuu").Select
Set sh = Sheets("Sayfa1")
sat = sh.Cells(65536, "B").End(xlUp).Row
If sat < 2 Then Exit Sub
ActiveSheet.PageSetup.PrintArea = "A2:L47"
say = 1
sat1 = 2
Do While say <= sat - 1
    Range("A8:L38").ClearContents
    sat2 = 8: say2 = say2 + 1
    Do While sat2 <= 38 And say <= sat - 1
        Cells(sat2, "A").Value = say
        Cells(sat2, "C").Value = sh.Cells(sat1, "A").Value
        Cells(sat2, "D").Value = sh.Cells(sat1, "B").Value
        Cells(sat2, "E").Value = sh.Cells(sat1, "C").Value
        Cells(sat2, "F").Value = sh.Cells(sat1, "E").Value
        Cells(sat2, "G").Value = sh.Cells(sat1, "G").Value
        Cells(sat2, "H").Value = sh.Cells(sat1, "H").Value
        say = say + 1
        sat2 = sat2 + 1
        sat1 = sat1 + 1
    Loop
    If MsgBox("[ " & say2 & " nci syafayı yazdırmak isityormusunuz?", _
    vbYesNo, "YAZDIR") = vbYes Then
        ActiveSheet.PrintOut
    End If
Loop
MsgBox "Yazdırma işlemi bitti." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[METİN580]

teşekkürler. Ellerinize sağlık

 

[Orion1]

teşekkürler. Ellerinize sağlık

Rica ederim.
iyi çalışmalar.