以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  PDF报表保存  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=87414)

--  作者:hongyefor
--  发布时间:2016/7/11 10:59:00
--  PDF报表保存

比如我有两个xls模版文件,想在同一个WebBrowser里显示,并保存在一个PDF文件里,请问是否可以

如果可以的话,怎么写这代码?


--  作者:大红袍
--  发布时间:2016/7/11 11:01:00
--  

 你要把两个excel打开,剪切合并到一起,再另存为pdf才行

 

\'另存为pdf代码

 

Dim App As New MSExcel.Application
try  
    Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("d:\\test.xls")
    \'创建Excel文件对应的PDF文件
    wb.Saved = True
    wb.ExportAsFixedFormat(MSExcel.XlFixedFormatType.xlTypePDF, "d:\\test.pdf", MsExcel.XlFixedFormatQuality.xlQualityStandard, True, False,  System.Reflection.Missing.Value,  System.Reflection.Missing.Value, True,  System.Reflection.Missing.Value)
    app.quit
catch ex As exception
    msgbox(ex.message)
    app.quit
End try

 


--  作者:hongyefor
--  发布时间:2016/7/11 11:31:00
--  

能不能帮我改一下

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:cdsh2.xls

 

代码:


 

Dim wbr As WinForm.WebBrowser = e.Form.Controls("WebBrowser1")
Dim r As Row = Tables("窗口1_Table1").Current
Dim tmp As String = ProjectPath & "Attachments\\cdsh2.xls"
Dim tmp1 As String = ProjectPath & "Attachments\\cdsh.xls"
Dim rpt1 As String = "d:/tpcd/"+(Tables("窗口1_Table1").Current("第三列")) + (Tables("窗口1_Table1").Current("第四列"))   +"01.xls"
Dim rpt As String = "d:/tpcd/"+(Tables("窗口1_Table1").Current("第三列")) + (Tables("窗口1_Table1").Current("第四列"))   +"清单.pdf"
If FileSys.FileExists(rpt) = False Then
    Dim Book As New XLS.Book(tmp)
    Book.Build()
    Book.SaveToPDF(rpt) \'保存为pdf文件
End If
If FileSys.FileExists(rpt1) = False Then
    Dim Book1 As New XLS.Book(tmp1)
    Book1.Build()
    Book1.Save(rpt1)\'保存为XLS文件
End If

wbr.AddRess = rpt


--  作者:大红袍
--  发布时间:2016/7/11 12:15:00
--  
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:downloads.zip


--  作者:hongyefor
--  发布时间:2016/7/11 12:52:00
--  

如何让她们两个表换页显示呢?

 


--  作者:大红袍
--  发布时间:2016/7/11 14:36:00
--  

Dim wbr As WinForm.WebBrowser = e.Form.Controls("WebBrowser1")
Dim r As Row = Tables("表A").Current
Dim tmp As String = ProjectPath & "Attachments\\cdsh2.xls"
Dim tmp1 As String = ProjectPath & "Attachments\\cdsh.xls"
Dim rpt1 As String = "d:/tpcd/"+(Tables("表A").Current("第三列")) + (Tables("表A").Current("第四列"))   +"01.xls"
Dim pdf As String = "d:/tpcd/temp/" & format(Date.now, "yyyyMMddHHmmss") & ".pdf"
Dim rpt As String = "d:/tpcd/"+(Tables("表A").Current("第三列")) + (Tables("表A").Current("第四列"))  +"清单.xls"

FileSys.CreateDirectory("d:/tpcd/temp")

Dim Book As New XLS.Book(tmp)
Book.Build()
Book.Save(rpt) \'保存为pdf文件

Dim Book1 As New XLS.Book(tmp1)
Book1.Build()
Book1.Save(rpt1)\'保存为pdf文件

Dim App1 As New MSExcel.Application
Dim App2 As New MSExcel.Application
try
    Dim Wb1 As MSExcel.WorkBook = App1.WorkBooks.Open(rpt1)
    Dim Wb2 As MSExcel.WorkBook = App2.WorkBooks.Open(rpt)
    Dim Ws1 As MSExcel.WorkSheet = Wb1.WorkSheets(1) \'指定要复制的工作表
    Dim Ws2 As MSExcel.WorkSheet = Wb2.WorkSheets(1)

    Ws2.UsedRange.Copy
    ws1.Select

    \'ws1.Cells(1,Ws1.UsedRange.Columns.Count).Select \'横向拷贝
ws1.hPageBreaks.Add(ws1.Cells(Ws1.UsedRange.Rows.Count+1,1))
    ws1.Cells(Ws1.UsedRange.Rows.Count+1,1).Select \'纵向拷贝

    ws1.paste

    wb1.Save
    wb2.Save

    wb1.ExportAsFixedFormat(MSExcel.XlFixedFormatType.xlTypePDF, pdf, MsExcel.XlFixedFormatQuality.xlQualityStandard, True, False,  System.Reflection.Missing.Value,  System.Reflection.Missing.Value, True,  System.Reflection.Missing.Value)
    \'app1.visible = True

    app1.quit
    app2.quit
catch ex As exception
    msgbox(ex.message)
    app1.quit
    app2.quit
End try

wbr.AddRess = pdf


--  作者:hongyefor
--  发布时间:2016/7/11 17:58:00
--  

Select  e.Book.TempLate

Case "工单"
Dim xh As Row = Tables("窗口1_Table1").Current("序号")
        e.Book.Marks("是否")=iif(e.DataRow("是否")=True,"全","半")
        e.Book.Marks("部门") = DataTables("信息").Find("[_Identify] = \'"& xh &"\'")

End Select

 

BuildDetail

在生成某个细节区之前执行。

 

帮我看看错在哪里啊


--  作者:hongyefor
--  发布时间:2016/7/11 18:03:00
--  

图片点击可在新窗口打开查看此主题相关图片如下:cw.jpg
图片点击可在新窗口打开查看

--  作者:大红袍
--  发布时间:2016/7/12 0:41:00
--  

Select  e.Book.TempLate
   
    Case "工单"
        Dim xh As String = Tables("窗口1_Table1").Current("序号")
        e.Book.Marks("是否") = iif(e.DataRow("是否")=True,"全","半")
        Dim fdr As DataRow = DataTables("信息").Find("[_Identify] = \'"& xh &"\'")
        If fdr IsNot Nothing Then
            e.Book.Marks("部门") = fdr("部门")
        End If
End Select