主题：PDF报表保存

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

如果可以的话，怎么写这代码？

 你要把两个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

 

能不能帮我改一下

下载信息  [文件大小：   下载次数： ]

点击浏览该文件: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

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:downloads.zip

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

 

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

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

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

 

帮我看看错在哪里啊

此主题相关图片如下：cw.jpg

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