• DİKKAT

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

Belge_yazdir_makrosu

Katılım
5 Eylül 2006
Mesajlar
21
Excel Vers. ve Dili
basic
Selam;
Ekte dosyasini gönderdiğim makro için yardıma ihtiyacım var,
sorunum: BELGE sayfasında F2 hücresine notlar yazacağım her öğrenciye 100 uzerinden not vereceğim bu notların BELGEKURS sayfasında m18 hücresinde her kursiyer için yazıcıdan çıkması gerekecek,
Şimdiden teşekkürler.
 

Ekli dosyalar

Sadece F2 hücresine mi yoksa her öğrencinin karşısına gelen satıra mı yazdıracaksınız ?
 
BELGE sayfasında f1 hucresinde Notlar başlığı olacak f2 den aşağı doğru notları elle biz gireceğiz BELGEKURS sayfasındaki m18 de her öğrencinin notu yazıcıdan çıkacak.
 
Kodunuza aşağıdaki satırları ekledim, bir deneyin.
Kod:
Sub Düğme4_Tıklat()
    sayfaad = "Belge"
    ADET = InputBox("Kaç kişi için basım yapılacak?")
    For i = 1 To ADET
        AD = Worksheets(sayfaad).Cells(i + 1, 2).Value
        tc = Worksheets(sayfaad).Cells(i + 1, 3).Value
        [color=red][B]puan = Worksheets(sayfaad).Cells(i + 1, 6).Value[/color][/B]
        Worksheets("BELGEKURS").Cells(14, 3).Value = AD
        Worksheets("BELGEKURS").Cells(14, 12).Value = tc
        [color=red][B] Worksheets("BELGEKURS").[m18] = puan[/B][/color] 
       ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True
    Next i
End Sub
 
hamitcan,
ilgine teşekkür ederim, kodu ekledim "kurs belgesi yazdır" modulunu tıklayınca kursiyerlerin notları M18 de çıkmıyor, dosyayı sizin kodunuzuda eklyerek gönderiyorum bakarsanız sevinirim,
Kolay gelsin..
 

Ekli dosyalar

Aşağıdaki satırı eklememişziniz.
Kod:
Sub Düğme4_Tıklat()
    sayfaad = "Belge"
    ADET = InputBox("Kaç kişi için basım yapılacak?")
    For i = 1 To ADET
        AD = Worksheets(sayfaad).Cells(i + 1, 2).Value
        tc = Worksheets(sayfaad).Cells(i + 1, 3).Value
        [color=red][B]puan = Worksheets(sayfaad).Cells(i + 1, 6).Value[/color][/B]
        Worksheets("BELGEKURS").Cells(14, 3).Value = AD
        Worksheets("BELGEKURS").Cells(14, 12).Value = tc
        Worksheets("BELGEKURS").[m18] = puan
       ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True
    Next i
End Sub
 
Merhaba hamitcan vermiş olduğun bilgiler için minnettarım çok işime yaradı çok sağol. Bir şey daha rica edebilirmiyim acaba. Şimdi bu makroda kaç kişi için basım yapılacak soruna ne girersek girelim hep baştan başlıyor yazmaya. Acaba herhangi bir hücredeki bir değerden başlayıp yazdırma şansımız varmı. Şu anki makroda 5 tane yaz dediğim zaman 1 den başlayıp 5 e kadar yazıyor. Ama ben 5 tane yaz dediğim zaman örneğin a5 hücresinde 10 yazıyor sa 10 dan itibaren 5 tane yazmasını istiyorum. yani 10 ile 15 arasında olanları yazmasını istiyorum. Nasıl bir cümle yazmam gerkeiyor yardımcı olabilirmisin. İşin içinden çıkamadım. Benim kullandığım kod böyle.

Sub toplubasim()
adet = InputBox("Kaç kişi için basım yapılacak?")
For i = 1 To adet
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True
tumislemler
kasaplar = i + 1
Sayfa1.Range("m2").Value = kasaplar
tumislemler
Next i
End Sub
 
Merhaba hamitcan vermiş olduğun bilgiler için minnettarım çok işime yaradı çok sağol. Bir şey daha rica edebilirmiyim acaba. Şimdi bu makroda kaç kişi için basım yapılacak soruna ne girersek girelim hep baştan başlıyor yazmaya. Acaba herhangi bir hücredeki bir değerden başlayıp yazdırma şansımız varmı. Şu anki makroda 5 tane yaz dediğim zaman 1 den başlayıp 5 e kadar yazıyor. Ama ben 5 tane yaz dediğim zaman örneğin a5 hücresinde 10 yazıyor sa 10 dan itibaren 5 tane yazmasını istiyorum. yani 10 ile 15 arasında olanları yazmasını istiyorum. Nasıl bir cümle yazmam gerkeiyor yardımcı olabilirmisin. İşin içinden çıkamadım. Benim kullandığım kod böyle.

Sub toplubasim()
adet = InputBox("Kaç kişi için basım yapılacak?")
For i = 1 To adet
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True
tumislemler
kasaplar = i + 1
Sayfa1.Range("m2").Value = kasaplar
tumislemler
Next i
End Sub

Konuyu unuttum, küçük bir dosya ekleyin, istediğinizi kısaca belirtin.
 
Merhaba,

Ekteki dosyada BELGEKURS sayfasında KURS BELGESİ YAZDIR diye buton var. Ona tıkladığımız zaman "Kaç kişi için basım yapılacak?" diye soru soruyor. Oraya örneğin 2 diye değer girdiğimizde otomatik olarak BELGE sayfasından 1. ve 2. sıradaki kayıtları yazdırıyor. Ama her seferinde baştan başıyor yazmaya. Yani siz 5 kişi için basım yap derseniz 1.2.3.4. ve 5. için basım yapıyor. Benim istediğim iki sayı arasını yazdırmak. Yani 10 ile 15 arasını yazdır diyebilmek istiyorum. Bu konuda yardımcı olabilirmisiniz.
 

Ekli dosyalar

Merhaba,

Ekteki dosyada BELGEKURS sayfasında KURS BELGESİ YAZDIR diye buton var. Ona tıkladığımız zaman "Kaç kişi için basım yapılacak?" diye soru soruyor. Oraya örneğin 2 diye değer girdiğimizde otomatik olarak BELGE sayfasından 1. ve 2. sıradaki kayıtları yazdırıyor. Ama her seferinde baştan başıyor yazmaya. Yani siz 5 kişi için basım yap derseniz 1.2.3.4. ve 5. için basım yapıyor. Benim istediğim iki sayı arasını yazdırmak. Yani 10 ile 15 arasını yazdır diyebilmek istiyorum. Bu konuda yardımcı olabilirmisiniz.

Kod:
Sub Düğme4_Tıklat()
Dim x() As Integer, n As Integer, ii As Integer, j As Integer
Dim sayfaad As String, ADET As String, a() As String
On Error GoTo hata
    sayfaad = "Belge"
    ADET = InputBox("Aralıklı Seçim İçin= :" & Chr(10) & "Karışık Seçim İçin= ,", "Kaç kişi için basım yapılacak?")
    
    If InStr(1, ADET, ":") <> 0 Then
            n = InStr(1, ADET, ":")
            For ii = Left(ADET, Len(ADET) - n) To Right(ADET, Len(ADET) - n)
                ReDim Preserve x(ii)
                x(ii) = ii
            Next
    Else

            a = Split(ADET, ",")
            For ii = 0 To UBound(a)
              ReDim Preserve x(ii)
              x(ii) = a(ii)
            Next
    End If
    For j = 0 To UBound(x)
            If x(j) <> 0 Then
                      Worksheets("BELGEKURS").Cells(14, 3) = Worksheets(sayfaad).Cells(x(j), 2) 'AD
                      Worksheets("BELGEKURS").Cells(14, 12) = Worksheets(sayfaad).Cells(x(j), 3) 'TC
                      Worksheets("BELGEKURS").[m18] = Worksheets(sayfaad).Cells(x(j), 6)   'PUAN
                      ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True
                      'ActiveSheet.PrintPreview
            End If
    Next
hata:
    If Err.Number = 13 Then MsgBox "Yazımda Bir Hata Var": Exit Sub
End Sub
 
Geri
Üst