seçim yapma

[erdenek]

arkadaşlar merhaba
ekteki dosyada seçmeli dersler için dilekçe hazırlama dosyası var.Bu dosyada yazdırmak istediğim sınıfların seçimini yapmak istiyorum.yani toplu yazdırma işi.

 

[erdenek]

yok mu arkadaşlar bir gelişme

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Private Sub CommandButton1_Click()
    On Error Resume Next
    For Each Veri In Selection
        Cells(Veri.Row, 1).Select
        txtsınıfı = ActiveCell.Offset(0, 0).Value
        txtokulnumarası = ActiveCell.Offset(0, 1).Value
        txttckimlikno = ActiveCell.Offset(0, 2).Value
        txtadısoyadı = ActiveCell.Offset(0, 3).Value
        txtveliadısoyadı = ActiveCell.Offset(0, 4).Value
        txtadısoyadı2 = txtadısoyadı
        txtbugün = CDate(Date)
        
        ysn = Left(txtsınıfı, Len(txtsınıfı) - 2)
        
        y_imi = Array("txtsınıfı", "txtokulnumarası", "txttckimlikno", "txtadısoyadı", "txtveliadısoyadı", "txtbugün", "txtadısoyadı2")
        dizi = Array(txtsınıfı, txtokulnumarası, txttckimlikno, txtadısoyadı, txtveliadısoyadı, txtbugün, txtadısoyadı2)
        yol = ThisWorkbook.Path
        Set wd = CreateObject("word.Application")
        wd.Visible = True
        If ysn = 5 Then
        wd.Application.Documents.Open yol & "\" & "5.SINIF.doc"
        Else
        If ysn = 6 Then
        wd.Application.Documents.Open yol & "\" & "6.SINIF.doc"
        Else
        If ysn = 7 Then
        wd.Application.Documents.Open yol & "\" & "7.SINIF.doc"
        Else
        If ysn = 8 Then
        wd.Application.Documents.Open yol & "\" & "8.SINIF.doc"
        Else
        MsgBox "SEÇTİĞİNİZ SINIFA AİT BİR DİLEKÇE ŞABLONU BULUNAMADI!", vbCritical
        Exit Sub
        End If
        End If
        End If
        End If
        
        For X = 0 To 6
        wd.ActiveDocument.Bookmarks(y_imi(X)).Range.Select
        wd.Selection = dizi(X)
        wd.ActiveDocument.Bookmarks.Add Range:=wd.Selection.Range, Name:=y_imi(X)
        Next
        
        Application.DisplayAlerts = False
        Set wddoc = wd.ActiveDocument
        wddoc.SaveAs yol & "\" & txtadısoyadı & " - Dilekçe (" & CDate(Date) & ").doc"
        wddoc.PrintOut
        wddoc.Close
    Next
End Sub

 

[erdenek]

Aşağıdaki kodu deneyiniz.

Private Sub CommandButton1_Click()
    On Error Resume Next
    For Each Veri In Selection
        Cells(Veri.Row, 1).Select
        txtsınıfı = ActiveCell.Offset(0, 0).Value
        txtokulnumarası = ActiveCell.Offset(0, 1).Value
        txttckimlikno = ActiveCell.Offset(0, 2).Value
        txtadısoyadı = ActiveCell.Offset(0, 3).Value
        txtveliadısoyadı = ActiveCell.Offset(0, 4).Value
        txtadısoyadı2 = txtadısoyadı
        txtbugün = CDate(Date)
        
        ysn = Left(txtsınıfı, Len(txtsınıfı) - 2)
        
        y_imi = Array("txtsınıfı", "txtokulnumarası", "txttckimlikno", "txtadısoyadı", "txtveliadısoyadı", "txtbugün", "txtadısoyadı2")
        dizi = Array(txtsınıfı, txtokulnumarası, txttckimlikno, txtadısoyadı, txtveliadısoyadı, txtbugün, txtadısoyadı2)
        yol = ThisWorkbook.Path
        Set wd = CreateObject("word.Application")
        wd.Visible = True
        If ysn = 5 Then
        wd.Application.Documents.Open yol & "\" & "5.SINIF.doc"
        Else
        If ysn = 6 Then
        wd.Application.Documents.Open yol & "\" & "6.SINIF.doc"
        Else
        If ysn = 7 Then
        wd.Application.Documents.Open yol & "\" & "7.SINIF.doc"
        Else
        If ysn = 8 Then
        wd.Application.Documents.Open yol & "\" & "8.SINIF.doc"
        Else
        MsgBox "SEÇTİĞİNİZ SINIFA AİT BİR DİLEKÇE ŞABLONU BULUNAMADI!", vbCritical
        Exit Sub
        End If
        End If
        End If
        End If
        
        For X = 0 To 6
        wd.ActiveDocument.Bookmarks(y_imi(X)).Range.Select
        wd.Selection = dizi(X)
        wd.ActiveDocument.Bookmarks.Add Range:=wd.Selection.Range, Name:=y_imi(X)
        Next
        
        Application.DisplayAlerts = False
        Set wddoc = wd.ActiveDocument
        wddoc.SaveAs yol & "\" & txtadısoyadı & " - Dilekçe (" & CDate(Date) & ").doc"
        wddoc.PrintOut
        wddoc.Close
    Next
End Sub

üstadım bir türlü beceremedim.