Sub VeriToSablon()
Dim wsVeri As Worksheet
Dim wsSab As Worksheet
Dim sonSatir As Long
Dim i As Long
Dim sablonBaslangic As Long
Dim blokYuksekligi As Long
Dim kayitSayisi As Long
Dim musteriSutun As Integer, urunSutun As Integer, barkodSutun As Integer
Dim siparisSutun As Integer, faturaSutun As Integer, fiyatSutun As Integer
Dim kdvSutun As Integer, giderSutun As Integer, kullanımSutun As Integer
Dim tarihSutun As Integer
Dim musteriHucresi As String, tarihHucresi As String
Dim urunHucresi As String, faturaHucresi As String, tutarHucresi As String
Dim paperSize As Integer ' Makroda değiştirilebilir: A5=11, A4=1, A3=8 vb.
On Error GoTo HataYakala
' Sayfa boyutu ayarı (makroda değiştir: A5 için 11, A4 için 1, A3 için 8 vb.)
paperSize = 11 ' A5 boyutu (değiştirilebilir)
' Sayfaları ata
Set wsVeri = ThisWorkbook.Sheets("VERI")
Set wsSab = ThisWorkbook.Sheets("SABLON")
' Veri sayfasındaki son satırı bul (A sütunu baz alınarak, başlık satırı 1 varsayımı)
sonSatir = wsVeri.Cells(wsVeri.Rows.Count, "A").End(xlUp).Row
' Şablon başlangıç satırı
sablonBaslangic = 1
' Her şablon bloğunun yüksekliği (görüntüye göre ~21 satır, değiştirilebilir)
blokYuksekligi = 21 ' A5 için blok yüksekliği, makroda değiştir
' Sütun genişlikleri (A'dan I'ya kadar, makroda her birini değiştirilebilir)
Dim AGenislik As Single: AGenislik = 8 ' A sütunu genişliği (etiketler için)
Dim BGenislik As Single: BGenislik = 25 ' B sütunu (veri için)
Dim CGenislik As Single: CGenislik = 12 ' C sütunu (barkod veya ek veri için)
Dim DGenislik As Single: DGenislik = 15 ' D sütunu (sipariş no için)
Dim EGenislik As Single: EGenislik = 14 ' E sütunu (fatura no için)
Dim FGenislik As Single: FGenislik = 12 ' F sütunu (tutar için)
Dim GGenislik As Single: GGenislik = 10 ' G sütunu (KDV için)
Dim HGenislik As Single: HGenislik = 11 ' H sütunu (gider için)
Dim IGenislik As Single: IGenislik = 15 ' I sütunu (tarih için)
' VERI sütun numaraları (makroda değiştirilebilir)
musteriSutun = 1 ' A: Müşteri
urunSutun = 2 ' B: Ürün
barkodSutun = 3 ' C: Barkod (kullanılmayabilir)
siparisSutun = 4 ' D: Sipariş No
faturaSutun = 5 ' E: Fatura No
fiyatSutun = 6 ' F: Fiyat (tutar için kullanılabilir)
kdvSutun = 7 ' G: KDV
giderSutun = 8 ' H: Gider
kullanımSutun = 9 ' I: Kullanım
tarihSutun = 9 ' I: Pusula Tarihi (Düzeltme: J yerine I sütunu için 9 olarak değiştirildi)
' SABLON hücre pozisyonları (veri için, makroda değiştirilebilir)
musteriHucresi = "B3" ' Müşteri verisi (A3 etiketi yanında)
tarihHucresi = "I2" ' Tarih verisi (H2 etiketi yanında)
urunHucresi = "B10" ' Ürün verisi
faturaHucresi = "B11" ' Fatura No verisi
tutarHucresi = "I19" ' Tutar verisi (H19 etiketi yanında)
' Mevcut şablon sayfasını temizle
wsSab.Cells.Clear
kayitSayisi = 0
' Her veri satırı için döngü (başlık satırını atla, 2'den başla)
For i = 2 To sonSatir
' Filtrelenmiş satırları kontrol et: Sadece görünen satırları işle
If wsVeri.Rows(i).Hidden = False Then
' Sabit etiketleri yaz (her blok için)
wsSab.Range("A3").Offset(kayitSayisi * blokYuksekligi, 0).Value = "Müşteri Bilgileri:"
wsSab.Range("A10").Offset(kayitSayisi * blokYuksekligi, 0).Value = "Ürün:"
wsSab.Range("A11").Offset(kayitSayisi * blokYuksekligi, 0).Value = "Fatura No"
wsSab.Range("H2").Offset(kayitSayisi * blokYuksekligi, 0).Value = "Tarih"
wsSab.Range("H19").Offset(kayitSayisi * blokYuksekligi, 0).Value = "Tutar"
' Sayfa boyutu ölçüsünü yaz (her bloğun altına, A21'e)
Dim sayfaOlcu As String
If paperSize = 11 Then
sayfaOlcu = "A5 Boyut: 14.8 x 21 cm"
ElseIf paperSize = 1 Then
sayfaOlcu = "A4 Boyut: 21 x 29.7 cm"
ElseIf paperSize = 8 Then
sayfaOlcu = "A3 Boyut: 29.7 x 42 cm"
Else
sayfaOlcu = "Özel Boyut"
End If
wsSab.Range("A21").Offset(kayitSayisi * blokYuksekligi, 0).Value = sayfaOlcu
' Veri doldurma: Sütunlara göre
' Müşteri
wsSab.Range(musteriHucresi).Offset(kayitSayisi * blokYuksekligi, 0).Value = wsVeri.Cells(i, musteriSutun).Value
' Tarih (Pusula Tarihi) - Artık I sütunundan (satır i) doğru şekilde çekiliyor
wsSab.Range(tarihHucresi).Offset(kayitSayisi * blokYuksekligi, 0).Value = wsVeri.Cells(i, tarihSutun).Value
wsSab.Range(tarihHucresi).Offset(kayitSayisi * blokYuksekligi, 0).NumberFormat = "dd.mm.yyyy" ' Tarih formatı
' Ürün
wsSab.Range(urunHucresi).Offset(kayitSayisi * blokYuksekligi, 0).Value = wsVeri.Cells(i, urunSutun).Value
' Eğer barkod eklemek istersen: wsSab.Range("B12").Offset(...).Value = wsVeri.Cells(i, barkodSutun).Value
' Fatura No
wsSab.Range(faturaHucresi).Offset(kayitSayisi * blokYuksekligi, 0).Value = wsVeri.Cells(i, faturaSutun).Value
' Tutar (Fiyat sütunundan)
wsSab.Range(tutarHucresi).Offset(kayitSayisi * blokYuksekligi, 0).Value = wsVeri.Cells(i, fiyatSutun).Value
wsSab.Range(tutarHucresi).Offset(kayitSayisi * blokYuksekligi, 0).NumberFormat = "#,##0.00" ' Para formatı
' Diğer sütunlar (örneğin KDV, Gider eklemek istersen buraya ekle)
' wsSab.Range("B13").Offset(...).Value = wsVeri.Cells(i, kdvSutun).Value
' Kayıt sayısını artır
kayitSayisi = kayitSayisi + 1
End If
Next i
' Sütun genişliklerini ayarla (A'dan I'ya kadar, A5 için optimize)
wsSab.Columns("A").ColumnWidth = AGenislik
wsSab.Columns("B").ColumnWidth = BGenislik
wsSab.Columns("C").ColumnWidth = CGenislik
wsSab.Columns("D").ColumnWidth = DGenislik
wsSab.Columns("E").ColumnWidth = EGenislik
wsSab.Columns("F").ColumnWidth = FGenislik
wsSab.Columns("G").ColumnWidth = GGenislik
wsSab.Columns("H").ColumnWidth = HGenislik
wsSab.Columns("I").ColumnWidth = IGenislik
' J sütunu için: wsSab.Columns("J").AutoFit ' Otomatik ayarla (gerekirse ekle)
' Sayfa boyutunu makroda belirlenen değere ayarla
With wsSab.PageSetup
.PaperSize = paperSize ' Makroda değiştirilen değer (A5=11 vb.)
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = kayitSayisi ' Her blok A5 yüksekliğinde, toplam sayfaya sığdır (veya False için uzun sayfa)
.PrintArea = wsSab.Range("A1").Resize(kayitSayisi * blokYuksekligi + 1, 10).Address ' Ölçü satırı dahil +1 satır
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.4)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
End With
Application.CutCopyMode = False
MsgBox "Veriler SABLON'a aktarıldı! Sayfa boyutu: " & sayfaOlcu & ". Her satır için 1 blok. Toplam " & kayitSayisi & " kayıt."
Exit Sub
HataYakala:
MsgBox "Hata: " & Err.Description
End Sub
