yazdırma işlemi

[ismailayan]

merhaba arkadaşlar.

yine burdan destek alarak bir modul oluşturmuştum. ama eksik var.

Benim Sayfa1 ve Sayfa2 isimle excel dosyam var. Sayfa1 de listem sayfa2 de stiket formatlı sayfam var. Sayfa1 deki A1 hüçresine ("*") koyduklarımı sayfa2 de gerekli hücrelere koyup yazdırma işlemi yapıyordum.

Sorun burda başlıyor. Etikette 12 tane stiker olduğu için her seferinde 3000 kayıt üzerinde 12 tane ("*") koyup yazdırıp o şekilde devam ediyor.

ben etiket bastırılacak kısımlara ("*") koyup her 12'şer 12'şer mesaj çıkartarak örnk(Devam etmek istiyormusunuz"),vbyesno) olarak yazdırma işlemine devam etmsini istiyorum.

kod aşada arkadaşlar dosyayıda gönderiyorum

Sub dene()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim GenelKontrol
adet = WorksheetFunction.CountA(s1.Range("a2:a65536"))

ReDim adres(1 To adet, 2 To 6)

sira = 1
For x = 2 To s1.[b65536].End(3).Row
If s1.Cells(x, 1) = "*" Then
For y = 2 To 6
adres(sira, y) = s1.Cells(x, y)
Next y

sira = sira + 1
End If
Next x
s2.Select
For x = 1 To UBound(adres) Step 24
Cells.ClearContents
For xx = 0 To 7
sat = (xx * 4) + 1
For xxx = 0 To 1
'GenelKontrol = GenelKontrol + 1
'If GenelKontrol = 14 Then
'MsgBox "*'ları + yap"

'End If
sut = (xxx * 2) + 1
Cells(sat, sut).Select
Top = Top + 1
Cells(sat, sut) = "Sayın: " & adres(Top, 2)
Cells(sat + 1, sut) = adres(Top, 3) & " " & adres(Top, 4)
Cells(sat + 2, sut) = adres(Top, 5) & "/" & adres(Top, 6)
If Top = adet Then GoTo atla
Next xxx
Next xx
atla:
'If MsgBox("Sayfayı Yazdırmak İçin Tamam'a Basın", vbYesNo) = vbYes Then ActiveWindow.SelectedSheets.PrintOut
Next x
s1.Select
End Sub

 

[ismailayan]

arkadaşlar çok zor birşeymi istedim.

bu işlem benim için gerçekten çok önemli
45620 adetlik bir etiket basımım var. mutlaka bir çözüm yolu bulmak zorundayım.

bu konuda yardımınızı rica ediyorum

 

[ismailayan]

?????????????????????

 

[ismailayan]

yaa arkadaşlar okuyup geçmeyin

fikri olan paylaşsın lütfen