第一版：主要思路，数据的处理顺序，代码架构。中间还要补充很多代码呢。

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("请先<a href="https://www.jb51.cc/tag/tianjia/" target="_blank" class="keywords">添加</a>单号到右边列表中！",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" '检查<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a>路径 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 '一单只去一次明细表<a href="https://www.jb51.cc/tag/shujuku/" target="_blank" class="keywords">数据库</a>数据。 OdDtlTBs = OdDtlCls.GetAOrderSDetailTB(OdDM.OrderItemNo) '接下来是处理一个定单的所有明细货号的<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a>。 ShowMsg("处理所选的定单的货号<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a>...") If ImgPathTypePick = AddImgPathType.SysPath Or ImgPathTypePick = AddImgPathType.CustomPath Then '<a href="https://www.jb51.cc/tag/shanchu/" target="_blank" class="keywords">删除</a>PicDir所有临时<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a><a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a> 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("正在<a href="https://www.jb51.cc/tag/huoqu/" target="_blank" class="keywords">获取</a><a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a>和压缩为小<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a>:" & 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("正在<a href="https://www.jb51.cc/tag/huoqu/" target="_blank" class="keywords">获取</a><a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a>和压缩为小<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a>:" & 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("<a href="https://www.jb51.cc/tag/tianjia/" target="_blank" class="keywords">添加</a>工作表Sheet...") xlBook = xlApp.Workbooks.Add PrgBar.Value = 5 '写入<a href="https://www.jb51.cc/tag/shengcheng/" target="_blank" class="keywords">生成</a>模板，备料单的格式，第一个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 '在外面过滤分部分工厂明细号。减少读取<a href="https://www.jb51.cc/tag/sql/" target="_blank" class="keywords">sql</a><a href="https://www.jb51.cc/tag/shujuku/" target="_blank" class="keywords">数据库</a>的<a href="https://www.jb51.cc/tag/cishu/" target="_blank" class="keywords">次数</a>。 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 '如果没有写工厂。就填写定单总数据。总的明细表<a href="https://www.jb51.cc/tag/neirong/" target="_blank" class="keywords">内容</a> End If End If xlApp.Visible = True '保存Excel<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>，一个单号一个<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>名 Next End Sub