• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Çoklu Yazdırma ?

  • Konbuyu başlatan Konbuyu başlatan angurya
  • Başlangıç tarihi Başlangıç tarihi
Katılım
17 Kasım 2008
Mesajlar
28
Excel Vers. ve Dili
Excel 2007
Mrb ,
veriler isimli sayfada bulunan kayıtlardan bir kısmını YOLLUKLAR isimli sayfadaki bordro ya sıra ile çağırıp yazdırmak istiyorum. Bir kod oluşturmaya çalıştım ama olmadı. Yardımlarınızı bekliyorum. Şimdiden teşekkürler.

Sub cmdMultiplePrint_Click()

Dim say As Integer
say = WorksheetFunction.CountA(Range("A1:A65000"))
If txtsira_no = say Then
Exit Sub
Else
txtsira_no = txtsira_no + 1
cbAd = Cells(txtsira_no + 1, 2)
txtTitle = Cells(txtsira_no + 1, 3)
txtLimit = Cells(txtsira_no + 1, 4)
txtSicilNo = Cells(txtsira_no + 1, 5)
txtKimlikNo = Cells(txtsira_no + 1, 6)
txtIbanNo = Cells(txtsira_no + 1, 7)
txtGsmNo = Cells(txtsira_no + 1, 8)
For i = 1 To 177
txtToplam.Value = Cells(txtsira_no + 1, 9).Value
Controls("TextBox" & i).Value = Cells(txtsira_no + 1, i + 9).Value
Next


Sheets("YOLLUKLAR").Select

'Bordronun kimlik bilgileri gönderiliyor
[B1] = cbAd
[B2] = txtKimlikNo.Text
[C2] = txtIbanNo.Text
[J55] = txtToplam.Value
[J57] = cbAd.Cells
[J58] = txtSicilNo
kopyala_temizle

'Bordronun B sütununa Yol Bilgisi gönderiliyor

j = 7
For i = 4 To 176 Step 4
If Controls("TextBox" & i) <> Empty Then
Cells(j, "B").Value = Controls("TextBox" & i).Text
j = j + 1
End If
Next

'Bordronun E sütununa Alındı Sıra No gönderiliyor

j = 7
For i = 2 To 174 Step 4
If Controls("TextBox" & i) <> Empty Then
Cells(j, "E").Value = Controls("TextBox" & i).Text
j = j + 1
End If
Next
'Bordronun C sütununa Makbuz Tarihi gönderiliyor
j = 7
For i = 3 To 175 Step 4
If Controls("TextBox" & i) <> Empty Then
Cells(j, "C").Value = Controls("TextBox" & i).Text
'Bordronun A sütununa Makbuz Tarihi gönderiliyor
Cells(j, "A").Value = Controls("TextBox" & i).Text
j = j + 1
End If
Next

'Bordronun J sütununa Makbuz tutarları gönderiliyor

j = 7
For i = 1 To 173 Step 4
If Controls("TextBox" & i) <> Empty Then
Cells(j, "J").Value = Controls("TextBox" & i).Text
j = j + 1
End If
Next
kopyala_1
hizala
'Sheets(YOLLUKLAR).PrintOut

End If
Application.ScreenUpdating = False
Application.Visible = True
Application.ScreenUpdating = True
frmVeri.Hide
'
Sheets(Array("YOLLUKLAR")).PrintPreview
Application.ScreenUpdating = False
Application.Visible = True
Application.ScreenUpdating = True
Sheets("veriler").Select
frmVeri.Show


End Sub
 
Geri
Üst