X

الطباعة الى الوورد كود بحاجة لتعديل VB.net

Programming Languages

 
  • Filter
  • Time
  • Show
Clear All
new posts
  • ibrahimmi
    Thread Author
    Free Membership
    • Nov 2018 
    • 16 

    السلام عليكم ورحمة الله وبركاته

    اعمل على برنامج يقوم بطباعة شهادات الطلاب الى الوور عند ضغط زر طباعة يقوم بنقل البيانات الى الوور في قالب تم عمله مسبقا الطباعة تتم بنجاح في حال تمت العملية لطالب واحد حسب هذا الكود

    Code:
    Public Sub Print()
    Try
    '--------------------------------------------------------------
    MSO.SetDllFiles()
    '--------------------------------------------------------------
    Dim MyWord As MSO.MSWord
    
    MyWord = New MSO.MSWord(Me)
    
    Dim TemplatePath As String = My.Application.Info.DirectoryPath & TextBox2.Text
    
    Dim TemplateInfo As New MSO.TemplateInfo(TemplatePath)
    With TemplateInfo
    '-------------------------------------
    .Caption = "التقرير"
    .PrintJob = GetPrintableJob2()
    With .ViewOptions
    '-------------------------------------
    .ShowBookmarks = False
    .ShowTableGridlines = False
    .ArabicNumeral = MSO.Enums.MSArabicNumeral.NumeralHindi
    .DisplayPageBoundaries = True
    .NormalViewDisplayRulers = True
    .ViewType = MSO.Enums.MSViewType.PrintPreview
    .WindowState = MSO.Enums.MSWindowState.Maximize
    .NormalViewZoomPageFit = MSO.Enums.MSPageFit.PageFitBestFit
    .NormalViewZoomPercentage = Nothing
    '------------------------
    .PrintPreviewDisplayRulers = True
    .PrintPreviewPageFitness = New MSO.PrintPreviewPageFitness(0, 0)
    .PrintPreviewZoomPageFit = MSO.Enums.MSPageFit.PageFitBestFit
    .PrintPreviewZoomPercentage = Nothing
    '-------------------------------------
    End With
    End With
    MyWord.AddNewTemplateInfo(TemplateInfo)
    '---------------------------------------
    'MyWord.PrintOut()
    MyWord.PrintPreview()
    Catch ex As Exception
    MSO.PrintingProcess.ShowErrorMsgAndClose(ex.Message)
    End Try
    
    End Sub
    
    Private Function GetPrintableJob2() As MSO.Printing.PrintJob
    Dim PrintJob As New MSO.Printing.PrintJob
    Load_supervisor()
    With PrintJob
    .AddText(StudName.Text, "StudName")
    .AddText(mark01.Text, "mark01")
    .AddText(mark02.Text, "mark02")
    .AddText(mark03.Text, "mark03")
    .AddText(mark04.Text, "mark04")
    .AddText(mark05.Text, "mark05")
    .AddText(mark06.Text, "mark06")
    .AddText(mark07.Text, "mark07")
    .AddText(mark08.Text, "mark08")
    .AddText(mark09.Text, "mark09")
    .AddText(mark10.Text, "mark10")
    .AddText(mark11.Text, "mark11")
    .AddText(mark12.Text, "mark12")
    .AddText(mark13.Text, "mark13")
    .AddText(mark14.Text, "mark14")
    
    With .AddTable()
    .DataTable = Get_Data()
    '-------------------------------------
    '.MinimumRowsAtTheBeginningOfTable = 3
    .IsFirstColumnAutoNumber = False
    .TableHeadBookMarkName = "TableHead_1"
    .FirstRowBookMarkName = "TableFirstRow_1"
    .DeleteTableIfNoData = False
    
    End With
    End With
    Return PrintJob
    End Function
    
    Public Function Get_Data()
    con.Open()
    Dim dt1 As New DataTable
    Dim cmd As New OleDbCommand("Select * From yearly where ID=@ID", con)
    cmd.Parameters.Clear()
    cmd.Parameters.AddWithValue("@ID", OleDbType.Integer).Value = id.Text
    Dim adp As New OleDbDataAdapter(cmd)
    adp.Fill(dt1)
    con.Close()
    Return dt1
    End Function
    
    Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click
    Print2()
    End Sub

    المطلوب هو طباعة الشهادات الى الوورد حسب الصف بمعنى اقوم بالاستعلام عن طلبة الصف الرابع مثلا واضغط طباعة يتم ارسال البيانات الى الوورد ولو كان عدد الطلاب 40 يظهر لي ملف ب40 صفحة يظهر في كل صفحة شهادة كل واحد منهم، الكود السابق يعمل في حالة طباعة طالب واحد فقط


    قمت بتجربة تعديل جملة الاستعلام ما حدث ان البيانات جميعها ظهرت في صفحة واحدة


    ارجو تعديل الكود ليتناسب مع المطلوب ولكم جزيل الشكر
  • ibrahimmi
    Thread Author
    Free Membership
    • Nov 2018 
    • 16 

    #2
    هل من اجابة؟
    Comment
    • ibrahimmi
      Thread Author
      Free Membership
      • Nov 2018 
      • 16 

      #3
      ارجو حذف الموضوع لعدم وجود اجابة
      Comment
      Working...
      X