专家坐堂-运行有点慢，能不能帮我改进一下呢Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

-- 运行有点慢，能不能帮我改进一下呢

Dim fr As String

fr = e.Form.name & "_"

Dim kh As WinForm.Label = e.Form.Controls("客户")

Dim kd As WinForm.Label = e.Form.Controls("客户担当")

Dim pm As WinForm.Label = e.Form.Controls("品名")

Dim ks As WinForm.Label = e.Form.Controls("款号")

Dim kss As String = ks.Text

kss = kss.Trim

Dim yk As WinForm.Label = e.Form.Controls("样衣款号")

Dim yks As String = yk.Text

yks = yks.Trim

Dim lb As WinForm.Label = e.Form.Controls("类别")

Dim jh As WinForm.Label = e.Form.Controls("计划交期")

Dim bj As WinForm.TextBox = e.Form.Controls("报价金额")

Dim zz As WinForm.TextBox = e.Form.Controls("最终价格")

Dim dru1 As DataRow

dru1 = DataTables(fr & "订单核价系统").Find("客户 = \'" & kh.Text & "\'And 客户担当 = \'" & kd.Text & "\'And 类别 = \'" & lb.Text & "\'And 品名 = \'" & pm.Text & "\'And 款号 = \'" & ks.Text & "\'And 样衣款号 = \'" & yk.Text & "\'")

Dim tm As String = ProjectPath & "RemoteFiles\\kt\\" \'指定目录文件夹

Dim gps() As String = {"面料","辅料","二次加工"} \'定义分组名称

Dim te() As String = {"客户","客户担当","类别","品名","款号","样衣款号","报价数量","计划交期","原料费用","辅料费用","二次加工费用","工缴费用","其他费用","管理费用","核价金额","技术担当"}

Dim cls() As String = {"款号","样衣款号","项目名称","规格","成份或质地","克重","门幅","单位","单耗","单价","金额","供应商","分类"} \'定义列名

Dim lxs() As Object = {"String","String","String","String","String","Short","String","String","Double","Double","Double","String","String"} \'定义Type类型

Dim wdh() As String = {140,140,140,135,90,45,45,45,58,65,67,88,85}

Dim dtb As New DataTableBuilder("临时核价表")

For i As Integer = 0 To cls.Length - 1

If lxs(i) = "String" Then

dtb.AddDef(cls(i),Gettype(String))

ElseIf lxs(i) = "Double" Then

dtb.AddDef(cls(i),Gettype(Double))

ElseIf lxs(i) = "Short" Then

dtb.AddDef(cls(i),Gettype(Short))

End If

dtb.Build()

For i As Integer = 0 To cls.Length - 1

Tables("临时核价表").Cols(cls(i)).Width = wdh(i)

For i As Integer = 0 To gps.Length - 1

Dim dt As DataTable = DataTables(fr & gps(i) &"核价")

Dim drs As List(Of DataRow) = dt.Select("款号 = \'" & kss & "\'and 样衣号 like \'%" & yks & "%\'","_sortkey")

For Each dr As DataRow In drs

Dim r As DataRow = DataTables("临时核价表").AddNew()

r("款号") = dr("款号")

r("样衣款号") = dr("样衣号")

r("项目名称") = dr(gps(i) & "名称")

If dt.DataCols.Contains("规格") Then

r("规格") = dr("规格")

Else

r("规格") = Nothing

End If

If dt.DataCols.Contains("成份") Then

r("成份或质地") = dr("成份")

ElseIf dt.DataCols.Contains("辅料质地") Then

r("成份或质地") = dr("辅料质地")

Else

r("成份或质地") = Nothing

End If

If dt.DataCols.Contains("克重") Then

r("克重") = dr("克重")

Else

r("克重") = Nothing

End If

If dt.DataCols.Contains("门幅") Then

r("门幅") = dr("门幅")

Else

r("门幅") = Nothing

End If

r("单位") = dr("计量单位")

r("单价") = dr("单价")

If dt.DataCols.Contains("单耗") Then

r("单耗") = dr("单耗")

ElseIf dt.DataCols.Contains("数量") Then

r("单耗") = dr("数量")

End If

r("金额") = dr("金额")

r("供应商") = dr("供应商")

r("分类") = gps(i)

MainTable = Tables("临时核价表")

Dim de As Table = Tables("临时核价表")

Dim L1 As WinForm.Label = e.Form.Controls("L客户")

Dim L2 As WinForm.Label = e.Form.Controls("L客户担当")

Dim L3 As WinForm.Label = e.Form.Controls("L类别")

Dim L4 As WinForm.Label = e.Form.Controls("L品名")

Dim L5 As WinForm.Label = e.Form.Controls("L款号")

Dim L6 As WinForm.Label = e.Form.Controls("L样衣款号")

Dim L7 As WinForm.Label = e.Form.Controls("L报价数量")

Dim L8 As WinForm.Label = e.Form.Controls("L计划交期")

Dim F1 As WinForm.Label = e.Form.Controls("L原料费用")

Dim F2 As WinForm.Label = e.Form.Controls("L辅料费用")

Dim F3 As WinForm.Label = e.Form.Controls("L二次加工费用")

Dim F4 As WinForm.Label = e.Form.Controls("L工缴费用")

Dim F5 As WinForm.Label = e.Form.Controls("L其他费用")

Dim F6 As WinForm.Label = e.Form.Controls("L管理費用")

Dim Le() As String ={L1.text,L2.text,L3.text,L4.text,L5.text,L6.text}

Dim Fe() As String ={F1.text,F2.text,F3.text,F4.text,F5.text,F6.text}

Dim Tes() As String ={"客户","客户担当","类别","品名","款号","样衣款号"}

Dim fye() As String ={"原料费用","辅料费用","二次加工费用","工缴费用","其他费用","管理费用"}

Dim clsf() As String = {"项目名称","规格","成份或质地","克重","门幅","单位","单耗","单价","金额","供应商"} \'定义列名

Dim App As New MSExcel.Application

Dim Wb As MSExcel.Workbook = App.WorkBooks.Add

Wb.WorkSheets(1).name = "核价表"

Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)

\'------------------表头------------------------------------

Dim Rg As MSExcel.Range = Ws.Range("A1:P1")\'指定任意单元格

App.DisplayAlerts = False \'加上此行可禁止弹出合并前的提示

Rg.Merge \'合并指定区域的单元格

Rg.Value = e.Form.Controls("qymc").text & " " & e.Form.Controls("Label6").text

Rg.HorizontalAlignment = MSExcel.Constants.xlCenter

Rg.Font.Size = 14.25 \'字号

Rg.Font.Bold = True \'加粗

Rg.RowHeight = 40 \'行高40

Ws.Range("A1").ColumnWidth = 15 \'列宽15磅

Ws.Range("B1").ColumnWidth = 9

Ws.Range("C1").ColumnWidth = 6

Ws.Range("D1").ColumnWidth = 7

Ws.Range("E1").ColumnWidth = 8

Ws.Range("F1:I1").ColumnWidth = 4.6

Ws.Range("J1").ColumnWidth = 1.8

Ws.Range("K1").ColumnWidth = 5

Ws.Range("L1").ColumnWidth = 7

Ws.Range("M1").ColumnWidth = 10

Ws.Range("N1").ColumnWidth = 23

Ws.Range("O1").ColumnWidth = 1

Ws.Range("P1").ColumnWidth = 8

\'----------------------主表------------------------------

For i As Integer = 2 To 7

\'----------------------主表标题--------------------------

Dim Rg1 As MSExcel.Range = Ws.Range("A" & i & ":" & "B" & i)\'指定任意单元格

Rg1.Merge \'合并指定区域的单元格

Ws.Range("A" & i).Value = Le(i-2)

\'----------------------主表明细--------------------------

Dim Rg2 As MSExcel.Range = Ws.Range("C" & i & ":" & "M" & i)\'指定任意单元格

Rg2.Merge \'合并指定区域的单元格

Ws.Range("C" & i).Value = e.Form.Controls(tes(i-2)).text

\'--------------------------------------------------------

Dim Rg3 As MSExcel.Range = Ws.Range("A8:B8,C8:D8,E8:I8,J8:M8")\'指定任意单元格

Rg3.Merge \'合并指定区域的单元格

Ws.Range("A8").Value = L7.text

Ws.Range("C8").Value = e.Form.Controls("报价数量").text

Ws.Range("E8").Value = L8.text

Ws.Range("J8").Value = Cdate(e.Form.Controls("计划交期").text)

Ws.Range("J8").NumberFormat = "yyyy年mm月dd日" \'日期

If de.Count < 12

Dim Rg7 As MSExcel.Range

Rg7 = Ws.Range("B9:C9 ,D9:E9 ,I9:J9")\'指定任意单元格

Rg7.Merge \'合并指定区域的单元格

Dim Rg8 As MSExcel.Range

For i As Integer = 10 To 21

Rg8 = Ws.Range("B" & i & ":" & "C" & i & ",D" & i & ":" & "E" & i & ",I" & i & ":" & "J" & i)\'指定任意单元格

Rg8.Merge \'合并指定区域的单元格

Else

Dim Rg7 As MSExcel.Range

Rg7 = Ws.Range("B9:C9 ,D9:E9 ,I9:J9")\'指定任意单元格

Rg7.Merge \'合并指定区域的单元格

Dim Rg8 As MSExcel.Range

For i As Integer = 10 To de.Count +13

Rg8 = Ws.Range("B" & i & ":" & "C" & i & ",D" & i & ":" & "E" & i & "I" & i & ":" & "J" & i)\'指定任意单元格

Rg8.Merge \'合并指定区域的单元格

End If

Dim clF() As String = {"A","B","D","F","G","H","I","K","L","M"}\'引用不连续的单元格区域

For i As Integer = 0 To clsf.Length - 1

Dim RgC As MSExcel.Range

RgC = Ws.Range(clF(i) & "9") \'引用单个单元格

RgC.Value = clsf(i)

Dim RgU As MSExcel.Range = Ws.UsedRange

Dim RgS As MSExcel.Range

RgS = Ws.Range("A10:" & "M" & RgU.Rows.Count)\'指定任意单元格

RgS.BorderAround(MSExcel.XlLineStyle.xlContinuous,MSExcel.XlBorderWeight.xlThin,1)

Dim dvs As DataTable = DataTables("临时核价表")

Dim idx As Integer = 0

For Each ck As String In dvs.GetValues("分类","","分类 DESC")

Dim Rgt As MSExcel.Range = Ws.Range("A" & idx+10 & ":M" & idx+10)

Rgt.Merge

Rgt.HorizontalAlignment = MSExcel.Constants.xlLeft

Dim Rows = dvs.Select("分类=\'" & ck & "\'","分类 DESC")

Rgt.Value = ck

Rgt.Font.Size = 8 \'字号

Rgt.Font.ColorIndex = 5 \'颜色

Rgt.RowHeight = 18 \'行高18磅

idx += 1

Dim mcount As Integer = 0

For r As Integer = 0 To Rows.Count - 1 \'填入数据

For o As Integer = 0 To clsf.Length - 1

Dim Rgr As MSExcel.Range = Ws.Range(clF(o) & r+idx +10)

Rgr.Value = Rows(r)(clsf(o))

Rgr.ShrinkToFit = True

idx += Rows.Count

Dim Rgh As MSExcel.Range = Ws.UsedRange

Dim Rgf As MSExcel.Range = Ws.Range("N2:P" & Rgh.Rows.Count-6)

Rgf.Merge

Ws.Range("A2:M9,A" & Rgh.Rows.Count+1 & ":P" & Rgh.Rows.Count+2 ).RowHeight = 22 \'行高22磅

Dim iemg As Image = GetImage(tm & dru1("样衣款号") & dru1("款号") & ".jpg")

Dim h As Single = Rgf.Width / iemg.Width * iemg.Height

Dim z1 As Single = Rgf.Height - h

If z1 >=0

Dim T As Single = z1 / 2

ws.Shapes.AddPicture(tm & dru1("样衣款号") & dru1("款号") & ".jpg", Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoTrue,Rgf.left, Rgf.Top + T, Rgf.Width,h)

Else

Dim w As Single = Rgf.Height / iemg.Height * iemg.Width

Dim z2 As Single = Rgf.Width - w

Dim L As Single = z2 / 2

ws.Shapes.AddPicture(tm & dru1("样衣款号") & dru1("款号") & ".jpg", Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoTrue,Rgf.left + l, Rgf.Top, w,Rgf.Height)

End If

Rgf.HorizontalAlignment = MSExcel.Constants.xlCenter

Rgf.VerticalAlignment = MSExcel.Constants.xlCenter

For i As Integer = Rgh.Rows.Count-5 To Rgh.Rows.Count

Dim RgJ As MSExcel.Range = Ws.Range("N" & i & "," & "O" & i & ":P" & i)

RgJ.Merge

Ws.Range("N" & i).Value = Fe(i-Rgh.Rows.Count+5)

Ws.Range("O" & i).Value = e.Form.Controls(fye(i-Rgh.Rows.Count+5)).text

Ws.Range("O" & i).NumberFormat = "#,##0.00" \'货币

Dim Rgx As MSExcel.Range = Ws.Range("A" & Rgh.Rows.Count+1 & ":B" & Rgh.Rows.Count+1 & "," & "C" & Rgh.Rows.Count+1 & ":O" & Rgh.Rows.Count+1 & "," & "P" & Rgh.Rows.Count+1)

Rgx.Merge

Dim ve1 As String

Dim ve2 As String

Dim ve3 As String

If e.Form.Controls("核价金额").text = "核价金额"

ve1 = "没有核价记录"

Else

ve1 = e.Form.Controls("核价金额").text

End If

If e.Form.Controls("L报价金额1").text = "报价金额"

ve2 = "未报价"

Else

ve2 = e.Form.Controls("L报价金额1").text

End If

If e.Form.Controls("L最终价格1").text = "最终价格"

ve3 = "无最终价格"

Else

ve3 = e.Form.Controls("L最终价格1").text

End If

Ws.Range("A" & Rgh.Rows.Count+1).Value = e.Form.Controls("L核价金额").text

Ws.Range("C" & Rgh.Rows.Count+1).Value = "核价金额为:" & ve1 & " " & "元报价金额为:" & ve2 & " " & "元最终价格为:" & ve3 & " 元"

Ws.Range("P" & Rgh.Rows.Count+1).Value = e.Form.Controls("元").text

Ws.Range("C" & Rgh.Rows.Count+1 & ",P" & Rgh.Rows.Count+1).HorizontalAlignment = MSExcel.Constants.xlRight

Ws.Range("A" & Rgh.Rows.Count+2 & ":P" & Rgh.Rows.Count+2 ).Merge

Ws.Range("A" & Rgh.Rows.Count+2 & ":P" & Rgh.Rows.Count+2 ).Value = e.Form.Controls("L制表人").text & " " & e.Form.Controls("技术担当").text

Ws.Range("A2:M9,A" & Rgh.Rows.Count+2 & ":P" & Rgh.Rows.Count+2 ).HorizontalAlignment = MSExcel.Constants.xlLeft

Ws.Range("A1:P" & Rgh.Rows.Count+2 ).Font.Name = "微软雅黑"

Ws.Range("A2:M9,N" & Rgh.Rows.Count-5 & ":P" & Rgh.Rows.Count & ",A" & Rgh.Rows.Count+1 & ":P" & Rgh.Rows.Count+2 ).Font.Size = 11 \'字号

Ws.Range("A1:P1,A2:M9,N2:P" & Rgh.Rows.Count & ",A" & Rgh.Rows.Count+1 & ":P" & Rgh.Rows.Count+1 ).Borders.Linestyle = MSExcel.XlLineStyle.xlContinuous \'边框线型

Ws.Range("A1:P1,A2:M9,N2:P" & Rgh.Rows.Count & ",A" & Rgh.Rows.Count+1 & ":P" & Rgh.Rows.Count+1 ).Borders.Weight = MSExcel.XlBorderWeight.xlThin \'边框粗细

Ws.Range("A1:P1,A2:M9,N2:P" & Rgh.Rows.Count & ",A" & Rgh.Rows.Count+1 & ":P" & Rgh.Rows.Count+1 ).Borders.ColorIndex = 1 \'边框颜色\'

With Ws.PageSetup

.PrintArea = "A1:P" & Rgh.Rows.Count+2

\'.PrintArea = Ws.UsedRange.Address \'打印工作表的使用区域

.LeftMargin = 30 \'页面左边距

.RightMargin = 30 \'页面右边距

.TopMargin = 50 \'页面顶部边距

.BottomMargin = 50 \'页面底部边距

.CenterHorizontally = True

.Orientation = MSExcel.xlPageOrientation.xlLandscape \'横向打印

.Zoom = False \'以下设置将缩印在一页内

.FitToPagesWide = 1 \'按照1页的宽度打印

.FitToPagesTall = 1 \'按照1页的高度打印

End With

Dim tmp As String = "d:\\报价\\" & dru1("客户") & "\\" & dru1("样衣款号") & dru1("款号") & ".xlsx"

Dim rpt As String = "d:\\报价\\" & dru1("客户") & "\\" & dru1("样衣款号") & dru1("款号") & ".pdf"

If FileSys.DirectoryExists("d:\\报价\\" & dru1("客户") & "\\" ) Then \'如果目录文件夹存在

Wb.SaveAs(tmp)

Else

FileSys.CreateDirectory("d:\\报价\\" & dru1("客户") & "\\")

Wb.SaveAs(tmp)

End If

Dim pdf = MSExcel.XlFixedFormatType.xlTypePDF

Wb.ExportAsFixedFormat(pdf,rpt)

App.Quit

Forms("窗口1").Open