Excel'de Her Sayfaya Seri Numarası Ekleme Hakkında

[oguzdemir39]

Arkadaşlar merhaba,

Otelde günlük müşteri listesi hazırlamaktayız.

Gün - Müşteri Adı - vb - vb. olarak 5-6 sütun verimiz var.

Sayfanın en üst sağ kısmında her sayfa için seri numarası vermemiz isteniyor.

Örneğin 1 ocak 2021 tarihli müşteri listesi 3 sayfa tutuyor. A-000001 , A-000002 , A-000003 diye her sayfaya seri numarasını atacak. fakat 3. sayfada boşluk kaldı,
ama tarih 2 ocak oldu. 2 ocaktan itibaren ilgili müşteriler için seri numarası A-000004 diye yeni sayfadan devam edecek çıktı alırken.

Otomatik her sayfaya seri numarası verebileceğimiz, her yeni gün başladığında yeni bir sayfaya veri yazdırabileceğimiz böyle bir kodlama yapmamız mümkün mü?

Yardımlarınız ve desteğiniz için teşekkür ederim.

 

[Necdet]

Merhaba,

Sayfadan kastınız sheet mi?
Sheet se hangi hücreye dediğiniz seri numarası yazılacak?

Sayfadan kastınız yazdırılırken oluşan sayfa başlıkları mı?

Yani sorunuz net değil, paylaşım sitelerinden birine örnek dosyanızı ekleyerek açıklayınız ki sorunuzu çözmeye çalışan arkadaş(lar) sıkıntı içinde kalmasın.

 

[oguzdemir39]

Veriler tek sheet içinde sıralı olacak. yazdırırken her sayfanın sağ üst kısmında seri numarası görünecek. başlıklar ve otel logosu da her çıktı sayfasında sabit olacak. bir de yazdırma yapılırken ilgili günü seçme (sadece 2 ocak tarihini yazdır gibi) özelliği olabilirse kullanışlı olur. (seri numarasını otomatik algılaması koşulu ile)

MUSTERI LISTESI TASLAK

 

[Asri]

Deneyiniz.

- Buton işleminde tüm sayfalardaki başlıklar silinir ve yeniden oluşturulur.
Numaralar otomatik olarak artar. Artışlar sayısal artış şeklinde değil numaratör artışı olarak yapılır.
Numara içinde ABC gibi karakterleri de kullanabilirsiniz. Onlarda artacaktır.

Harici link,

MUSTERI LISTESI.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Dim veri() As String
Dim adet As Long
Dim gec As String
Dim elde, bakilansayi As Boolean
Dim numarastr As String
Const harfler As String = "ABCDEFGĞHIİJKLMNOÖPRSŞTUÜXWVYZ"
Const sayilar As String = "0123456789"
'Const sayilar As String = "01"
Const dahildegil As String = ".-/"
'Asri Akdeniz - asriakdeniz@gmail.com - www.asriakdeniz.com

Sub menu()
  numarastr = Range("F2").Value
  Call basliklarisil
  Call serinoekle
End Sub
  
Sub basliklarisil()
   sonsatir = Cells(Rows.Count, "A").End(3).Row + 1
   For i = sonsatir To 6 Step -1
      gec = Cells(i, "A").Value
      If gec = "" Or gec = "Tarih" Or gec = "OTEL LOGOSU" Then
         Rows(i).Delete
      End If
   Next i
End Sub
  
Sub serinoekle()
    sayfasayisi = ActiveSheet.HPageBreaks.Count
    i = 1
    While i <= sayfasayisi
       sayfasonu = ActiveSheet.HPageBreaks(i).Location.Row
       Range("A1:G5").Select
       Selection.Copy
       Range("A" & sayfasonu).Select
       Selection.Insert Shift:=xlDown
       numarastr = numarator(numarastr)
       Range("F" & sayfasonu + 1).Value = "'" & numarastr
       Range("F" & sayfasonu + 1).Select
       sayfasayisi = ActiveSheet.HPageBreaks.Count
       i = i + 1
    Wend

End Sub

Function numarator(numara) As String
   numara = StrReverse(numara)
   adet = Len(numara)
   ReDim Preserve veri(1 To adet)
   For i = 1 To adet
      veri(i) = Mid(numara, i, 1)
   Next i
  
   elde = False
   For j = LBound(veri) To UBound(veri)
      harf = veri(j)
      If InStr(dahildegil, harf) > 0 Then GoTo son
      bakilansayi = sayimi(harf)
      If bakilansayi Then
         veri(j) = sayiarttir(harf)
      Else
         veri(j) = harfarttir(harf)
      End If
      
      If elde = False Then
        Exit For
      End If
son:
   Next j
        
   For i = LBound(veri) To UBound(veri)
      veristr = veristr & veri(i)
   Next i
  
   veristr = StrReverse(veristr)
   If Left(veristr, 1) = Left(sayilar, 1) And elde Then
      numarator = "1" & veristr
   ElseIf Left(veristr, 1) = Left(harfler, 1) And elde Then
      numarator = Left(harfler, 1) & veristr
   Else
      numarator = veristr
   End If
End Function

Function harfarttir(harfstr) As String
    mevcutsira = InStr(harfler, harfstr)
    yenisira = Mid(harfler, mevcutsira + 1, 1)
    If yenisira = "" Then
       harfarttir = Mid(harfler, 1, 1)
       elde = True
    Else
       harfarttir = yenisira
       elde = False
    End If
End Function

Function sayiarttir(sayistr) As String
    mevcutsira = InStr(sayilar, sayistr)
    yenisira = Mid(sayilar, mevcutsira + 1, 1)
    If yenisira = "" Then
       sayiarttir = Mid(sayilar, 1, 1)
       elde = True
    Else
       sayiarttir = yenisira
       elde = False
    End If
End Function

Function sayimi(sadecesayistr)
  liste = "0123456789"
  For k = 1 To Len(sadecesayistr)
    harf = Mid(sadecesayistr, k, 1)
    If InStr(liste, harf) = 0 Then
       sayimi = False
       Exit Function
    End If
  Next k
  sayimi = True
End Function

 

[Necdet]

Alternatif :

Eğer makro bilmiyorsanız ben olsam şöyle yapardım.

Sayfa Düzeni
Yazdırma Başlıkları
Üstte Yinelenecek Satırlar : $1:$5

Üst Bilgi / Alt Bilgi
Özel Üst Bilgi
İstediğiniz Bölüme : A-00000&[Sayfa]
Tamam
Tamam

Olarak sayfa düzenini ayarladıktan sonra ilk 9 sayfayı yazdırdıktan sonra, 9 sayfadan sonrasını ise A-0000&[Sayfa] olarak yani Sıfır sayısını 1 azaltarak yazdırırdım.