第一版：主要思路，数据的处理顺序，代码架构。中间还要补充很多代码呢。
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
