vb sqlserver 导出html,VB.Net导出SQLServer数据到Excel中代码架构段

Private Sub BtCrtOrderPackList_Click(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles BtCrtOrderPackList.Click

If Me.ListItemNoS.Items.Count < 1 Then

ShowMsg("请先添加单号到右边列表中！",MsgType.Err)

Exit Sub

End If

Dim OdCLs As OrderClass

Dim OdDM As OrderDataModel

Dim OdDtlCls As OrderDetailClass

Dim OdDtlDM As OrderDetailDataModel

Dim OdDtlTBs As DataTable

Dim xlApp As Excel.Application

Dim xlBook As Excel.Workbook

Dim xlSheet As Excel.Worksheet

Dim myRange As Excel.Range

Dim i,j,k As Integer

Dim TotalRs As Integer

Dim RowNo,ColNo As Integer

Dim TB,SmTB As DataTable

Dim CurItemNo,CurImgPath,PicDir As String

Dim SmlImgSize As Size

Dim ImgRct As Rectangle

Dim ImgPt As Point

Dim QsCls As QSClass

TotalRs = Me.ListItemNoS.Items.Count

SmlImgSize = New Size(160,110)

Call GetCrtRpImgPathType()

PicDir = Application.StartupPath & "/SmallPic"

'检查图片路径

If IO.Directory.Exists(PicDir) Then

IO.Directory.Delete(PicDir,True)

End If

IO.Directory.CreateDirectory(PicDir)

'主程序开始，循环处理每一个定单

For k = 0 To Me.ListItemNoS.Items.Count - 1

OdCLs = New OrderClass

OdDM = OdCLs.GetOrderDM(Me.ListItemNoS.Items(k).ToString)

OdDtlCls = New OrderDetailClass

'一单只去一次明细表数据库数据。

OdDtlTBs = OdDtlCls.GetAOrderSDetailTB(OdDM.OrderItemNo)

'接下来是处理一个定单的所有明细货号的图片。

ShowMsg("处理所选的定单的货号图片...")

If ImgPathTypePick = AddImgPathType.SysPath Or ImgPathTypePick = AddImgPathType.CustomPath Then

'删除PicDir所有临时图片文件

DeleteALLFile(PicDir)

If Me.ImgPathTypePick = AddImgPathType.SysPath Then

QsCls = New QSClass

CurItemNo = ""

PrgBar.Visible = True

PrgBar.Maximum = OdDtlTBs.Rows.Count

PrgBar.Value = 0

For i = 0 To OdDtlTBs.Rows.Count - 1

CurItemNo = ""

PrgBar.Value = i + 1

CurItemNo = OdDtlTBs.Rows(i).Item("CompanyItmeNo").ToString

ShowMsg("正在获取图片和压缩为小图片:" & CurItemNo)

CurImgPath = ""

CurImgPath = QsCls.GetQSImg(CurItemNo)

If CurImgPath > "" Then

CreateAndSaveSmlPic(CurImgPath,SmlImgSize,PicDir)

End If

Next

PrgBar.Visible = False

Else

CurItemNo = ""

PrgBar.Visible = True

PrgBar.Maximum = OdDtlTBs.Rows.Count

PrgBar.Value = 0

For i = 0 To OdDtlTBs.Rows.Count - 1

PrgBar.Value = i + 1

CurItemNo = ""

CurItemNo = OdDtlTBs.Rows(i).Item("CompanyItmeNo").ToString

ShowMsg("正在获取图片和压缩为小图片:" & CurItemNo)

CurImgPath = ""

CurImgPath = Path.Combine(ImgPathCustom,CurItemNo & ".jpg")

If IO.File.Exists(CurImgPath) Then

CreateAndSaveSmlPic(CurImgPath,PicDir)

End If

Next

PrgBar.Visible = False

End If

End If

PrgBar.Visible = True

PrgBar.Maximum = 10

PrgBar.Value = 1

ShowMsg("创建Excel程序...")

xlApp = New Excel.Application

PrgBar.Value = 3

ShowMsg("添加工作表Sheet...")

xlBook = xlApp.Workbooks.Add

PrgBar.Value = 5

'写入生成模板，备料单的格式，第一个sheet。

ShowMsg("设置备料单表格行和列的格式...")

xlSheet = xlBook.Worksheets.Item(1)

PrgBar.Value = 6

With xlSheet

.Name = String.Format("备料单{0}",Date.Today.ToShortDateString)

.Cells.Font.Name = "Arial"

.Cells.Font.Size = 10

.Rows.RowHeight = 14

.Columns(1).ColumnWidth = 10

.Columns(2).ColumnWidth = 20

.Columns(3).ColumnWidth = 10

.Columns(4).ColumnWidth = 10

.Columns(5).ColumnWidth = 10

.Columns(6).ColumnWidth = 10

.Columns(7).ColumnWidth = 6

.Columns(8).ColumnWidth = 6

.Columns(9).ColumnWidth = 6

.Columns(10).ColumnWidth = 6

.Columns(11).ColumnWidth = 10

.Columns(12).ColumnWidth = 12

FillMyRange(.Range("A1:L1"),"备　料　单",14)

End With

With xlSheet

FillMyCell(.Range("F5"),"Date:" & Today.Date,True)

FillMyRange(.Range("B2:E2"),"*** COMPANY LIMITED",True,18)

FillMyRange(.Range("B3:E3"),"*****",11)

FillMyRange(.Range("B4:E4"),"Tel: 86-754-*****",11)

End With

'这里注意处理多个工厂。

Dim FtyTB As DataTable

'取出该订单的所有工厂ID，不重复的。

FtyTB = OdDtlCls.GetDetailsFactoryIDSet(OdDM.OrderItemNo)

Dim FtyRow As DataRow()

If FtyTB.Rows.Count > 0 Then

'在外面过滤分部分工厂明细号。减少读取sql数据库的次数。

FtyRow = OdDtlTBs.Select("FtyID=" & FtyTB.Rows(i)(0).ToString)

If FtyRow.Length > 0 Then

'ShowMsg("FtyRow.Length:" & FtyRow.Length)

For i = 0 To FtyRow.Length - 1

'写好一个后复制到另外一个工厂的sheet备料单。

'还有填写OdDM定单数据到Excel.Sheet中，填写每一个工厂的数据，数据从OdDtlTBs取。

Next

Else

'如果没有写工厂。就填写定单总数据。总的明细表内容

End If

End If

xlApp.Visible = True

'保存Excel文件，一个单号一个文件名

Next

End Sub