以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  如何实现后台生成报表及后台打印  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=113066)
--  作者：lxhmax
--  发布时间：2018/1/8 14:48:00
--  如何实现后台生成报表及后台打印
请问各位老师，如何实现报表后台生成及打印，就是不占用操作，点完打印之后可以继续执行其他操作，而不是需要等到报表打印完成后才能执行其他操作？

现在的代码是这样的，执行完大概要10几秒；

Dim k1 As String = e.Form.Controls("打印机").value
Dim rkmb As String = "海吉星商户自主送检测试结果通知单"
If e.Form.Controls("打印方式").value = "直接打印" AndAlso k1 = "" Then
    Messagebox.Show("请先选择[ 打印机 ]!","错误提示",MessageBoxButtons.OK, MessageBoxIcon.Warning)
    e.Form.Controls("打印机").Select
    Return
End If
_dyj = k1

Dim mb As String = ProjectPath & "Excel模板\\"& rkmb & ".xlsx"
Dim fl As String = ProjectPath & "excel\\自主送检结果通知单\\自主送检-" & vars("委托单号") & ".xlsx"
If FileSys.FileExists(fl) = True Then
    If MessageBox.Show("该[ 自主送检结果通知单 ]已经打印过了,请问是否覆盖重新打印?", "提示", MessageBoxButtons.YESNO, MessageBoxIcon.Question) = DialogResult.NO Then
        Return
    End If
End If
If FileSys.FileExists(mb) = False Then
    Messagebox.Show("[ 自主送检结果通知单 ]Excel模板路径[ " & mb & " ]不存在或已经被删除,生成失败!","错误提示",MessageBoxButtons.OK, MessageBoxIcon.Warning)
    e.Form.close
    Return
End If
Dim kk,sj As String
If FileIsOpened(fl) = True Then
    MessageBox.Show(vars("委托单号") & ".xlsx""文件正在打开中,请先关闭再执行打印操作!","温馨提示",MessageBoxButtons.OK, MessageBoxIcon.Warning)
    Return
End If
If e.Form.Controls("打印方式").value = "直接打印"
    vars("打印方式$#") = "直接打印"
Else
    vars("打印方式$#") = "打印预览"
End If
vars("提示") = "正在生成报表中,请稍后……"
Forms("提示").show
Application.DoEvents()
Dim Book As New XLS.Book(mb)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Book.Build() \'生成细节区
Book.Save(fl) \'保存工作簿

Dim Ap As New MSExcel.Application
Dim Wb1 As MSExcel.WorkBook = Ap.WorkBooks.Open(fl)
Dim Ws1 As MSExcel.WorkSheet = Wb1.WorkSheets(1)
Dim nn,sl,zh As String
nn = Tables("临时委托明细表").Rows.Count
sl = nn + 6
zh = 20
If nn < 15 Then
    Dim Rg As MSExcel.Range = Ws1.Range("A" & sl & ":E" & zh)
    Rg.Borders(MSExcel.XlBordersIndex.xlEdgeBottom).LineStyle = 0
    Ap.DisplayAlerts = False \'加上此行可禁止弹出合并前的提示
    Rg.Merge  \'合并指定区域的单元格
    Dim Rg1 As MSExcel.Range = Ws1.Range("A" & sl)
    Rg1.VerticalAlignment = MSExcel.Constants.xlTop
    Rg1.Value = "---以下空白---"
End If
Ap.Visible = False
Wb1.save
Ap.Quit


Forms("提示").close
Select Case vars("打印方式$#")
    Case "直接打印"
        vars("提示") = "正在打印[ 自主送检结果通知单 ],请稍后……"
        Forms("提示").show
        Dim App As New MSExcel.Application
        Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
        Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
        App.Visible = False
        Dim obj As object = CreateObject("WScript.Network")
        obj.SetDefaultPrinter(k1)
        Application.DoEvents()
        Ws.PrintOut
        wb.save
        wb.close
        App.Quit
        Forms("提示").close
    Case Else
        Dim Proc As New Process
        Proc.File = fl
        Proc.Start()
End Select

Forms("自主通知单打印").Close
--  作者：有点甜
--  发布时间：2018/1/8 15:28:00
--  

使用多线程处理，比如

 

全局代码

 

Public Sub thread_sub1(ByVal obj As Object)
    functions. Execute("多线程操作", obj)
End Sub

 

内部函数（多线程操作）

 

Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(args(0))
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
\'App.Visible = True
\'Ws.PrintPreview
ws.printout
App.Quit

 

调用代码

 

Dim nthread As New System.Threading.Thread(AddressOf thread_sub1)
nthread.start("d:\\test.xls")