- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- 原来好好的，现在不知道为什么不行了 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=188067)
-- 发布时间：2023/8/30 15:48:00
-- 原来好好的，现在不知道为什么不行了
Dim year As String = e.F orm.Controls("所属年").Value
Dim moth As String = e.F orm.Controls("所属月").Value
If year = "" OrElse moth = "" Then
Messagebox.show("请选择工资报表所属的年和月,如果需要查询全年工资,请点击历史工资表选项!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Return
End If
e.Form.Controls("WebBrowser1").Visible = True
Dim wbr As WinForm.WebBrowser = e.F orm.Controls("WebBrowser1")
wbr.AddRess = Nothing
Dim cmd As New SQLCommand
Dim dt As DataTable
Dim cmb As WinForm.ComboBox
cmd.C
cmd.CommandText = "SELECT DISTINCT 企业名称 F rom {企业信息}"
Dim Values = cmd.ExecuteValues
If Values.Count > 0 Then
Vars("qymc") = Values("企业名称")
End If
Dim filter As String = "类别 = \'结算方式\' And 名称 like \'%上海农商银行%\'"
Dim ds0 As DataTable
cmd.C
cmd.CommandText = "SELECT * F rom {部门明细}"
ds0 = cmd.ExecuteReader()
Dim Names As List(Of DataRow) = ds0.Select(filter)
Dim Sum As String
Dim dytj As String
Dim ci As Integer
If Names.Count > 0 Then
For ci = 1 To Names.Count-1
sum = Sum & " or 银行账号 Like \'" & Names(ci)("代码") & "%\'"
Next
dytj = "银行账号 Like \'" & Names(0)("代码") & "%\'" & sum
End If
Dim r As Row = Tables("工资报表_Table1").Current
Dim tmp As String = ProjectPath & "Attachments\\工资清单.xls"
Dim tmp1 As String = ProjectPath & "Attachments\\银行接口报表.xls"
Dim tmp2 As String = ProjectPath & "Attachments\\工资签收单.xls"
Dim rpt1 As String = "d:/工资/" + (r("所属年份")) + (r("所属月份")) + "01.xls"
Dim rpt2 As String = "d:/工资/" + (r("所属年份")) + (r("所属月份")) + "无卡签收表.xls"
Dim pdf As String = "d:/工资/temp/" + (r("所属年份"))+ "年" + (r("所属月份")) +"月工资报表.pdf"
Dim rpt As String = "d:/工资/" + (r("所属年份")) + (r("所属月份")) + "工资清单.xls"
FileSys.CreateDirectory("d:/工资/temp")
If FileSys.FileExists(rpt) = True Then
FileSys.DeleteFile(rpt)
End If
If FileSys.FileExists(rpt1) = True
FileSys.DeleteFile(rpt1)
End If
If FileSys.FileExists(rpt2) = True
FileSys.DeleteFile(rpt2)
End If
If FileSys.FileExists(pdf) = True
FileSys.DeleteFile(pdf)
End If
If FileSys.FileExists(rpt) = False Then
Dim Book As New XLS.Book(tmp)
Book.Build()
Book.Save(rpt) \'保存为XLS文件
End If
If FileSys.FileExists(rpt2) = False Then
Dim Book1 As New XLS.Book(tmp2)
Book1.Build()
Book1.Save(rpt2)\'保存为XLS文件
End If
Dim App1 As New MSExcel.Application
Dim App2 As New MSExcel.Application
try
Dim Wb1 As MSExcel.WorkBook = App1.WorkBooks.Open(rpt)
Dim Wb2 As MSExcel.WorkBook = App2.WorkBooks.Open(rpt2)
Dim Ws1 As MSExcel.WorkSheet = Wb1.WorkSheets(1) \'指定要复制的工作表
Dim Ws2 As MSExcel.WorkSheet = Wb2.WorkSheets(1)
Ws2.UsedRange.Copy
ws1.Select
Dim count As Integer = Ws1.UsedRange.Rows.Count+1
Ws1.Rows(count).PageBreak = MSExcel.XlPageBreak.xlPageBreakManual
\'ws1.Cells(1,Ws1.UsedRange.Columns.Count).Select \'横向拷贝
ws1.Cells(count,1).Select \'纵向拷贝
ws1.paste
For i As Integer = count To Ws1.UsedRange.Rows.Count
If ws1.cells(i,1).Text.Contains("本页合计") Then
If i < Ws1.UsedRange.Rows.Count Then
Ws1.Rows(i+1).PageBreak = MSExcel.XlPageBreak.xlPageBreakManual
End If
End If
Next
wb1.Save
wb2.Save
wb1.ExportAsFixedFormat(MSExcel.XlFixedFormatType.xlTypePDF,pdf,MsExcel.XlFixedFormatQuality.xlQualityStandard,True, False,System.Reflection.Missing.Value,System.Reflection.Missing.Value,False,System.Reflection.Missing.Value)
\'app1.visible = True
app1.quit
app2.quit
catch ex As exception
msgbox(ex.message)
app1.quit
app2.quit
End try
If FileSys.FileExists(rpt1) = False Then
Dim Book2 As New XLS.Book(tmp1)
Dim Sheets As XLS.Sheet = Book2.Sheets(0)
Sheets(1,5).Value = "<" & dytj & ">" \'写入打印条件
Book2.Build()
Book2.Save(rpt1)\'保存为XLS文件
Dim Appl As New MSExcel.Application
Dim Wba As MSExcel.WorkBook = Appl.WorkBooks.Open(rpt1)
Dim Wsa As MSExcel.WorkSheet = Wba.WorkSheets(1)
Dim Rt As MSExcel.Range = Wsa.UsedRange
Dim r1 As String = CStr(Rt.Rows.Count + 3)
Dim r2 As String = CStr(Rt.Rows.Count)
Dim sr As String = CStr(Rt.Rows.Count + 4)
Dim s As String = "A2:D" &r2
Dim w As String = "1:" &r1
Dim rw As String = "F" &sr
Dim Rs As MSExcel.Range = Wsa.Range(s)
Rs.Cut(Wsa.Range(rw))
Dim Rg As MSExcel.Range = Wsa.Rows(w)\'选定多行
Rg.Delete(MSExcel.XlDirection.xlUp) \'下面的单元格上移
Rg = Wsa.Columns("A:E") \'选定多列
Rg.Delete(MSExcel.XlDirection.xlToLeft) \'右面的单元格左移
Wba.Save
Appl.quit
End If
wbr.AddRess = pdf
此主题相关图片如下：02.jpg
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:工资清单.xls |
[此贴子已经被作者于2023/8/30 15:54:02编辑过]
-- 发布时间：2023/8/30 16:02:00
--
调试技巧：http://www.foxtable.com/webhelp/scr/1485.htm，看哪一句代码出错
-- 发布时间：2023/8/30 16:18:00
--
求帮忙，查不出来，不知道怎么会出现这个问题
-- 发布时间：2023/8/30 16:20:00
--
每一行之后都添加调试代码，看执行弹出哪一个提示框后出错
Dim year As String = e.F orm.Controls("所属年").Value
MessageBox.Show(1)
Dim moth As String = e.F orm.Controls("所属月").Value
MessageBox.Show(2)
If year = "" OrElse moth = "" Then
MessageBox.Show(3)
Messagebox.show("请选择工资报表所属的年和月,如果需要查询全年工资,请点击历史工资表选项!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Return
End If
MessageBox.Show(4)
……
[此贴子已经被作者于2023/8/30 16:20:17编辑过]
-- 发布时间：2023/8/30 16:43:00
--
问题出在这3个代码上，还有
Book.Build()Book1.Build()
Book2.Build()
还有一些其他窗口的提示也出现问题了
此主题相关图片如下：03.jpg
这个是从服务器FTP下载下来的后就出现乱码了
ftp1.Download("\\duihua.txt",ProjectPath & "Attachments\\duihua.txt") \'下载ftp上的上报文件
If FileSys.FileExists(ProjectPath & "Attachments\\duihua.txt") Then
Dim s1 As String = FileSys.ReadAllText(ProjectPath & "Attachments\\duihua.txt", Encoding.Default)
Dim sbu As new StringBuilder
Do While s1.Length> 24
sbu.AppendLine(s1.SubString(0,24))
s1 = s1.SubString(24)
Loop
sbu.Append(s1)
If dh.text <> "" Then
dh.text ="【系统提示】 " + (vblf) + sbu.ToString + " !"
Else
dh.text = "今天没有系统提示!"
End If
End If
-- 发布时间：2023/8/30 16:55:00
--
到命令窗口单独测试这些模板生成有没有问题，比如
Dim tmp As String = ProjectPath & "Attachments\\工资清单.xls"
Dim Book As New XLS.Book(tmp)
Book.Build()
Book.Save(rpt) \'保存为XLS文件
或者到打开模板设计，看预览有没有问题
-- 发布时间：2023/8/30 16:56:00
--
乱码看看
-- 发布时间：2023/8/30 17:03:00
--
会不会是操作系统问题？
-- 发布时间：2023/8/30 17:06:00
--
那要自己测试不同系统，才能做判断了