实质纲目
送货单完好代码1、在Sheet（送货单）里，界说变量
Dim ws As WorksheetDim tbl As ListObjectDim newRow As ListRowDim wsOrder As WorksheetDim wsInventory As WorksheetDim arrInventory(), currRow As Long
2、在Sheet（送货单）里，Worksheet_Change事件
Private Sub Worksheet_Change(ByVal Target As Range) Dim arrCustomer() Dim rng As Range 'MsgBox Target.Address If Target.Address = "$B$4" Then Range("H4") = newOrderNumber If Range("B4") = "" Then Range("B5") = "" Range("B6") = "" Range("C5") = "" Range("B16") = "" Range("F17") = "" Else Set ws = ThisWorkbook.Sheets("客户贵府") Set tbl = ws.ListObjects("Customer") arrCustomer = tbl.DataBodyRange For i = 1 To UBound(arrCustomer) If arrCustomer(i, 3) = Target Then Range("B5") = arrCustomer(i, 6) Range("B6") = arrCustomer(i, 5) Range("C5") = arrCustomer(i, 7) Range("B16") = arrCustomer(i, 8) Range("F17") = arrCustomer(i, 9) Exit Sub End If Next End If ElseIf Not Intersect(Target, Range _ (Cells(8, "F"), Cells(13, "G"))) _ Is Nothing Then Cells(Target.Row, "H") = Cells(Target.Row, "F") * Cells(Target.Row, "G") End IfEnd Sub代码倡导：
（1）当B4单位格，客户称号发生篡改时，更新单子编号；要是客户称号为空，则把关联单位格清空，反之，则从客户贵府表中查找对应数据填入相应单位格。
（2）当单价、数据地点单位格发生篡改时，再行酌量金额。
3、在Sheet（送货单）里，Worksheet_SelectionChange事件：
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim strColWidth As String, ColWidth As Integer Set ws = ThisWorkbook.Sheets("客户贵府") Set wsOrder = ThisWorkbook.Sheets("送货单") Set wsInventory = ThisWorkbook.Sheets("制品编码") If (Not Intersect(Target, Range _ (Cells(8, 2), Cells(13, 3))) _ Is Nothing) And Target.Count = 1 Then currRow = Target.Row Set tbl = wsInventory.ListObjects("Inventory") arrInventory = tbl.DataBodyRange With Me.TextBox1 .Visible = True .Top = Target.Top .Height = Target.Height .Width = Target.Width .Left = Target.Left .Text = Target.Value End With With Me.ListBox1 .Visible = True .ColumnCount = 6 For i = 1 To 6 strColWidth = strColWidth & Me.Cells(currRow, i + 1).Width & ";" ColWidth = ColWidth + Me.Cells(currRow, i + 1).Width Next strColWidth = Left(strColWidth, Len(strColWidth) - 1) .ColumnWidths = strColWidth .Width = ColWidth + 5 .Top = Me.TextBox1.Top + Me.TextBox1.Height .Left = Me.Cells(currRow, 2).Left .Clear For i = 1 To UBound(arrInventory) .AddItem For j = 1 To 5 .List(k, j - 1) = arrInventory(i, j + 2) Next .List(k, 5) = arrInventory(i, 10) k = k + 1 Next .Height = 30 + (.ListCount - 1) * 10 If .Height > 120 Then .Height = 120 End If End With Else Me.TextBox1.Visible = False Me.ListBox1.Visible = False End IfEnd Sub代码倡导：（1）line6，判断刻下采选的单位格是否在居品编码或居品称号地点区域。（2）line10~11，把“制品编码“表中的超等表”Inventory”数据装入数组arrInventory。（3）line12~19，诞生Textbox1露馅，大小位置同决策单位格，Text值为决策单位格的文本。（4）line20~45，诞生Listbox1露馅及关联属性值。（A）line22，诞生Listbox栏目数为6列。
（B）line23~26，轮回责任表1~6列，把每列的列宽通过“;”连起来，准备给Listbox1的ColumnWidth赋值，同期把统共列宽加总，准备给ListBox1的Width赋值淫淫网最新地址，使得ListBox的栏目宽度与单位格宽度一致。
（5）line27~32，给ListBox1的ColumnWidth、Width赋值，Width在栏目总宽度上+5，幸免ListBox底部露馅退换条；诞生尖端、左边的位置，拔除实质。（6）line33~40，把商品信息添加到ListBox1，临了一列单价，咱们取的是“参考售价“，其位置与前边字段不衔接，单独赋值。（7）line41~44，诞生Listbox1的高度，最高为120，大致露馅10笔纪录，幸免商品过多变成ListBox高渡过高。（8）line47~48，要是采选的单位不在鸿沟内，或者数目大于1，覆盖Textbox1和ListBoxt1。4、在Sheet（送货单）里，ListBox1_Click事件：
Private Sub ListBox1_Click() With Me.ListBox1 For i = 0 To 3 Me.Cells(currRow, i + 2) = .List(.ListIndex, i) Next Me.Cells(currRow, 7) = .List(.ListIndex, 5) If Me.Cells(currRow, 6) = "" Then Me.Cells(currRow, 6) = 1 End If .Visible = False End With Me.TextBox1.Visible = FalseEnd Sub代码倡导：
（1）line3~6，把ListBoxt刻下点击的纪录写入责任表。
（2）line7~9，要是数目栏为空，填入1。
（3）line10，覆盖ListBox1。
（4）line12，覆盖TextBoxt1。
5、在Sheet（送货单）里，TextBox1_Change事件：
Private Sub TextBox1_Change() k = 0 With Me.ListBox1 .Clear For i = 1 To UBound(arrInventory) If InStr(arrInventory(i, 3) & arrInventory(i, 4), Me.TextBox1) Then .AddItem For j = 1 To 5 .List(k, j - 1) = arrInventory(i, j + 2) Next .List(k, 5) = arrInventory(i, 10) k = k + 1 End If Next End WithEnd Sub
代码倡导：凭据TextBox的文本筛选商品信息
（1）line4，把ListBoxt数据拔除。
（2）line6~13，通过轮回数组arrInventory，把包含TextBoxt1文本的纪录添加到ListBoxt1，已毕动态筛选的为止。
第四色6、在Sheet（送货单）里，敕令按钮CmdSave_Click事件：
Private Sub CmdSave_Click() Call saveOrderEnd Sub
7、在模块1里，saveOrder经由，保存数据：
Dim cnn As Object, rs As ObjectDim strCnn As String, dbs As String, sql As String, tb As StringSub saveOrder() Dim orderNumber As String Dim arr(), ckb As Object Dim ws As Worksheet, wsTarget As Worksheet Dim newRow As ListRow Application.ScreenUpdating = False Set ws = ThisWorkbook.Sheets("送货单") Set ckb = ws.Shapes("CheckBox1") orderNumber = ws.Range("H4") dbs = ThisWorkbook.FullName tb = "[汇总表$]" Set cnn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") strCnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " _ & dbs & ";Extended Properties='Excel 12.0 Xml;HDR=YES';" cnn.Open strCnn sql = "select count(*) from " & tb & " where 送货单号='" & orderNumber & "'" rs.Open sql, cnn arr = rs.getrows If arr(0, 0) <> 0 Then MsgBox "已存在送货单号！" ws.Range("H4") = newOrderNumber Exit Sub End If If ws.Cells(8, 2) = "" Then MsgBox "请正确填写商品信息！" Exit Sub End If If ckb.OLEFormat.Object.Object.Value = True Then If Application.Dialogs(xlDialogPrinterSetup).Show = False Then Exit Sub End If ws.PrintOut copies:=1 End If Set wsTarget = ThisWorkbook.Sheets("汇总表") Set tbl = wsTarget.ListObjects("BillList") For i = 8 To 13 If ws.Cells(i, 2) <> "" Then Set newRow = tbl.ListRows.Add newRow.Range(1, 1) = ws.Range("B4") newRow.Range(1, 2) = ws.Range("H6") newRow.Range(1, 3) = ws.Range("H4") For j = 8 To 1 Step -1 newRow.Range(1, j + 3).Value = ws.Cells(i, j).Value ws.Cells(i, j).Value = "" Next End If Next ws.Range("H4") = newOrderNumber Application.ScreenUpdating = TrueEnd Sub代码倡导：（1）line1~2，界说各人变量。（2）line3~7，界说变量。（3）line12~21，通过SQL查询汇总表中刻下单子编号数目。（4）line22~26，要是单子号已存在，退出经由。（5）line27~30，判断一下等8行第2列，也即是第一笔纪录商品编码是否为空，要是为空，则合计是莫得填数据。这里仅作念简便判断，还不错加多关于单价的判断，是否超出规矩鸿沟等等，咱们就不伸开了。（6）line31~36，判断“立即打印”CheckBox是否勾选，要是勾选了，采选打印机并打印，这里因为是在模块里，与在责任表中援用CheckBox的措施不同，在责任表中获胜用Me.CheckBox1。（7）line37~50，把”送货单“表数据写入“汇总表“。（A）line41，用以下语句在超等表中添加一瞥，有别于在凡俗责任表中添加纪录的作念法：
Set newRow = tbl.ListRows.Add
（B）line45~48，轮回添加衔接的纪录，这里的轮回是倒着的，原因是我想在把数据添加到汇总表后，就清空它，要是正着轮回，清空的时辰，会触发责任表Change事件，单价、数目为0，金额会为0，变成写入汇总表的时辰金额为0。
在这里折腾了好久，怎样汇总表金额就为0了呢？百念念不得其解，还以为是超等表有什么问题，好在最终是想显着了。
固然，咱们也不错等数据写完后再轮回清空。
（8）line51，更新“单子编号”。8、在模块1里，newOrderNumber自界说函数，更新单子编号：
Function newOrderNumber() Dim arr(), currOrderNo As String Dim currDate As String, lastDate As String Dim nextNo As Integer dbs = ThisWorkbook.FullName tb = "[汇总表$]" Set cnn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") currDate = Format(Now, "YYYYMMDD") strCnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " _ & dbs & ";Extended Properties='Excel 12.0 Xml;HDR=YES';" cnn.Open strCnn sql = "select top 1 送货单号 from " & tb & " order by 送货单号 DESC" rs.Open sql, cnn arr = rs.getrows If Not IsNull(arr(0, 0)) Then currOrderNo = arr(0, 0) lastDate = Mid(currOrderNo, 3, 8) End If If lastDate = currDate Then nextNo = Right(currOrderNo, 3) + 1 Else nextNo = 1 End If newOrderNumber = "HS" & currDate & Format(nextNo, "000")End Function代码倡导：（1）line5~15，查询已存在的最大的单子编号。（2）line16~19，要是莫得查到单子编号，诠释汇总表是空的，要是查到数据，则获得lastDate，最大的已存在的YYYYMMDD值。（3）line20~24，要是前边莫得查到单子编号，那么lastDate为空，或者查到了，但它所畴前的日历，那么判断lastDate不等至今天，则从1启动编号，要是lastDate等至今天，则把编号累加1。（4）line25，拼接函数值。9、在模块1里，NumToChar自界说函数淫淫网最新地址，数字金额大写：
Function NumToChar(Number As Double) As String Dim strNum As String Dim arrNum(), arrChar(), arrUnits(), arr() Dim k As Integer temp = Abs(Round(Number, 2)) * 100 strNum = CStr(temp) arrChar = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖") arrUnits = Array("分", "角", "元", "拾", "佰", "仟", "万", "拾", "佰", "仟", "亿", "拾", "佰", "仟", "兆", "拾", "佰", "仟", "京") For i = Len(strNum) To 1 Step -1 ReDim Preserve arr(k) arr(k) = Mid(strNum, i, 1) If arr(k) = 0 Then If InStr("元万亿兆", arrUnits(k)) Then arr(k) = arrUnits(k) Else arr(k) = "零" End If Else arr(k) = arrChar(arr(k)) & arrUnits(k) End If k = k + 1 Next strNum = "" For i = UBound(arr) To LBound(arr) Step -1 strNum = strNum & arr(i) Next If Round(Number, 0) = Number Then strNum = Left(strNum, InStr(strNum, "元")) & "整" ElseIf Round(Number, 1) = Number Then strNum = Left(strNum, InStr(strNum, "角")) & "整" End If Do While InStr(strNum, "零零") > 0 strNum = Replace(strNum, "零零", "零") Loop strNum = Replace(strNum, "零兆", "兆") strNum = Replace(strNum, "零亿", "亿") strNum = Replace(strNum, "零万", "万") strNum = Replace(strNum, "零元", "元") strNum = Replace(strNum, "兆亿", "兆") strNum = Replace(strNum, "兆万", "兆") strNum = Replace(strNum, "亿万", "亿") If Number < 0 Then strNum = "负" & strNum ElseIf Number = 0 Then strNum = "零元整" End If NumToChar = strNumEnd Function代码倡导：这个函数咱们特意共享过【自界说函数数字转汉文大写金额】，就未几啰嗦了。~~~~~~End~~~~~~
本站仅提供存储工作，统共实质均由用户发布，如发现存害或侵权实质，请点击举报。