专家坐堂-导出数据时提示超出65536行（已改为xlsx）Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  导出数据时提示超出65536行（已改为xlsx）  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=186432)

--  作者：HANZHIGANG
--  发布时间：2023/4/29 10:24:00
--  导出数据时提示超出65536行（已改为xlsx）

Dim Filter As String
With RibbonTabs("运单管理").Groups("运单管理").Items("上游客户")
If .text > "" Then
Filter = "上游客户 like \'%" & .text & "%\'"
End If
End With

With RibbonTabs("运单管理").Groups("运单管理").Items("品牌")
If .text > "" Then
If Filter > "" Then
Filter = Filter & " And "
End If
Filter = Filter & "品牌 like \'%" & .text & "%\'"
End If
End With

With RibbonTabs("运单管理").Groups("运单管理").Items("上游动态")
If .text > "" Then
If Filter > "" Then
Filter = Filter & " And "
End If
Filter = Filter & "上游动态 like \'%" & .text & "%\'"
End If
End With

With RibbonTabs("运单管理").Groups("运单管理").Items("运输单号")
If .text > "" Then
If Filter > "" Then
Filter = Filter & " And "
End If
Filter = Filter & "运输单号 like \'%" & .text & "%\'"
End If
End With

Dim cmd As New SQLCommand
cmd.C
Dim nms() As String = {"部门", "上游客户", "品牌", "商品车", "运输单号", "VIN码"}
If Filter > "" Then
cmd.CommandText = "Sel ect 部门,上游客户,品牌,商品车,运输单号,VIN码 F rom {运单管理} Where \'" & Filter & "\' "
Else
cmd.CommandText = "Sel ect 部门, 上游客户, 品牌, 商品车, 运输单号, VIN码 F rom {运单管理} "
End If

Dim dt As DataTable = cmd.ExecuteReader()

Dim Book As New XLS.Book
Dim fl As String = "c:\\reports\\test.xlsx"
Book.Save(fl)

Dim Sheet As XLS.Sheet = Book.Sheets(0)
Dim Style As Xls.Style = Book.NewStyle
Style.BackColor = Color.Red

For c As Integer = 0 To nms.Count - 1
Sheet(0, c).Value = nms(c)
Next
For r As Integer = 0 To dt.DataRows.Count - 1
For c As Integer = 0 To nms.Count - 1
Sheet(r + 1, c).Value = dt.DataRows(r)(nms(c))
Next
Next
\'打开工作簿
Book = New XLS.Book(fl)

Book.Save(fl)
Dim Proc As New Process
Proc.File = fl
Proc.Start()

--  作者：有点蓝
--  发布时间：2023/4/29 10:28:00
--

Dim dt As DataTable = cmd.ExecuteReader()

Dim Book As New XLS.Book
Dim fl As String = "c:\\reports\\test.xlsx"
Book.Save(fl)
\'重新打开工作簿
Book = New XLS.Book(fl)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Dim Style As Xls.Style = Book.NewStyle
Style.BackColor = Color.Red

For c As Integer = 0 To nms.Count - 1
Sheet(0, c).Value = nms(c)
Next
For r As Integer = 0 To dt.DataRows.Count - 1
For c As Integer = 0 To nms.Count - 1
Sheet(r + 1, c).Value = dt.DataRows(r)(nms(c))
Next
Next

Book.Save(fl)
Dim Proc As New Process
Proc.File = fl
Proc.Start()