送货单打印保存模板

aman1516

前几天帮跟单MM编了个所谓“OA”（当然，在VBA小白的小MM面前还是可吹虚一下的）的送货单，后面稍修正了一下，一般跟单打单需用到的功能都有了，MM说很实用，于是分享上来。
这个小菜也是参考EH的代码拼凑而成的，在EH得到了太多的朋友、老师的帮忙，分享，也算传达下EH精神吧。

一般功能：查询、保存、打印、汇总、分表及一些小功能.......简简单单，能用就好。

详见附件：   送货单模板20140315.rar (73.2 KB, 下载次数: 8623)

2014-3-15 17:31 上传

点击文件名下载附件

aman1516

2020/6/12 补充修订：
1）下拉列表由单选改为多选；
2）修订下拉列表中滚动鼠标滚轮时闪退的问题；
3）双击C列最末行保留手动插入行，亦可忽略自动插入

详见附件： 送货单模板20200612.rar (151.49 KB, 下载次数: 1324)

2020-6-13 00:15 上传

点击文件名下载附件

补充内容 (2020-11-3 19:54):
查询有个小BUG ，详见341楼

rjtang

谢谢分享，下载了。

jiminyanyan

谢谢分享.......

sanjiangren

下载了，就要留下个足印

sanjiangren

B3单元格起不到模糊查询录入的效果？

aman1516

B3单元格是方便手动输入新客户（这个并非好习惯），应先在客户资料表中录入好客户资料，做好基础数据库的更新维护，再进行操作：
1）用数据有效性的方法，在B3通过下拉选择客户名称。
2）如同样要模糊录入，则再建立一个TEXTBOX和一个LISTBOX，套用产品名称模糊查询录入的代码稍改一下即可。

zyuppier

学习了，谢谢

少如

aman1516 发表于 2014-3-22 16:23
B3单元格是方便手动输入新客户（这个并非好习惯），应先在客户资料表中录入好客户资料，做好基础数据库的更 ...

呵呵!  请您给作一下:
2）如同样要模糊录入，则再建立一个TEXTBOX和一个LISTBOX，套用产品名称模糊查询录入的代码稍改一下即可。
谢谢了!

aman1516

1)动态建立B3单元格的数据有效性：

Private Sub Worksheet_Activate()
'On Error Resume Next
Set D = CreateObject("Scripting.Dictionary")
arr = Sheets("客户资料").Range("c3:c" & Sheets("客户资料").Range("c65536").End(xlUp).Row)
For i = 1 To UBound(arr)
    D(arr(i, 1)) = ""
Next i
With Range("B3").Validation
     .Delete
     .Add xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(D.keys, ",")
End With

激活工作表时即自动更新下拉列表；

aman1516

少如 发表于 2014-4-21 09:11
呵呵!  请您给作一下:
2）如同样要模糊录入，则再建立一个TEXTBOX和一个LISTBOX，套用产品名称模糊查询录 ...

2)在工作表中添加一个TextBox2 和一个ListBox2控件
在代码最前面的代码：
Public Myr&, Arrsj
Dim crr     '增加一个公共数组变量
'然后添加以下代码 '（Worksheet_SelectionChange的代码与原来的合并在一起如下）：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.ListBox1.Clear
Me.TextBox1 = ""
Me.ListBox1.Visible = False
Me.TextBox1.Visible = False
'新增加代码
    Dim i As Integer
    Me.ListBox2.Clear
    crr = Sheets("客户资料").[A1].CurrentRegion
    Me.TextBox2.Value = ActiveCell.Value '将活动单元值赋给文本框
    If Target(1).MergeArea.Address = Range("B3").MergeArea.Address Then
           With Me.TextBox2
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left
                .Width = Target.Width
                .Height = Target.Height * 1.2
                .Activate
                .Text = ""
            End With
            With Me.ListBox2
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left + Target.Width
                .Width = Target.Width * 1.5
                .Height = Target.Height * 7
                For i = 2 To UBound(crr)
                    .AddItem crr(i, 3)
                Next
            End With
        Else
            Me.ListBox2.Clear
            Me.TextBox2 = ""
            Me.ListBox2.Visible = False
            Me.TextBox2.Visible = False
    End If
End Sub

Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim i As Integer
    Dim myStr As String
    Me.ListBox2.Clear
    With Me.TextBox2
        For i = 1 To Len(.Value)
            myStr = myStr & LCase(Mid$(.Value, i, 1))
        Next
    End With
        For i = 2 To UBound(crr)
            If InStr(crr(i, 3), myStr) Then
                Me.ListBox2.AddItem crr(i, 3)
            End If
        Next
End Sub

Private Sub ListBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Then
        ActiveCell.Value = ListBox2.Value
        [b4].Select
        Me.ListBox2.Clear
        Me.TextBox2 = ""
        Me.ListBox2.Visible = False
        Me.TextBox2.Visible = False
    End If
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ActiveCell.Value = ListBox2.Value
    [b4].Select
    Me.ListBox2.Clear
    Me.TextBox2 = ""
    Me.ListBox2.Visible = False
    Me.TextBox2.Visible = False
End Sub