vba编写的出库单（可添加出库项目记录、生成、打印出库单）

一、操作界面

二、使用说明

使用说明：

1、出库单号由8位出库日期和3位序列号组成，如20220606001；

2、出库单号只需填写序列号（1~999）；

3、当出库日期更新或出库单号不符合规则时，出库单号显示为系统默认可用序列号；

4、点击"添加"，将出库信息添加到出库清单

5、点击"生成"，生成出库单

6、选中出库清单中的记录，点击右键，可以删除该记录

7、双击出库清单，可以清空出库单中记录

三、vba代码

Private Sub UserForm_Initialize()

Dim w

Me.MultiPage_多页框架.Value = 0

Me.MultiPage_多页框架.Style = fmTabStyleNone

Me.DTPicker_出库日期.Value = VBA.Date

Me.TextBox_出库单号.MaxLength = 3

Me.TextBox_出库单号.Text = VBA.Format(1, "000")

ODONumberUpdate '更新出库单号

Me.TextBox_出库单号.SetFocus

PriceListTree '生成价格表

w = Me.ListView_出库清单.Width

Me.ListView_出库清单.ColumnHeaders.Add 1, "C1", "销售日期", w / 8 - 1

Me.ListView_出库清单.ColumnHeaders.Add 2, "C2", "出库单号", w / 8 - 1, lvwColumnCenter

Me.ListView_出库清单.ColumnHeaders.Add 3, "C3", "商品代码", w / 8 - 1, lvwColumnCenter

Me.ListView_出库清单.ColumnHeaders.Add 4, "C4", "商品名称", w / 8 - 1, lvwColumnCenter

Me.ListView_出库清单.ColumnHeaders.Add 5, "C5", "型号", w / 8 - 1, lvwColumnCenter

Me.ListView_出库清单.ColumnHeaders.Add 6, "C6", "销售数量", w / 8 - 1, lvwColumnCenter

Me.ListView_出库清单.ColumnHeaders.Add 7, "C7", "销售单价", w / 8 - 1, lvwColumnCenter

Me.ListView_出库清单.ColumnHeaders.Add 8, "C8", "销售金额", w / 8 - 1, lvwColumnCenter

Me.ListView_出库清单.FullRowSelect = True

Me.ListView_出库清单.Gridlines = True

Me.ListView_出库清单.View = lvwReport

End Sub

Private Sub CommandButton_打印_Click()

Dim sh As Worksheet, i As Integer, r As Integer

Set sh = Sheets("出库单")

r = sh.Range("B2").CurrentRegion.Rows.Count + 1

If r < 6 Then

MsgBox prompt:="出库清单为空，不能打印", Buttons:=vbOKOnly + vbInformation, Title:="提示"

Exit Sub

End If

sh.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

End Sub

Private Sub CommandButton_商品代码_Click()

Me.MultiPage_多页框架.Value = 1

End Sub

Private Sub CommandButton_生成_Click()

Dim sh As Worksheet, iItem As Object

Dim r As Integer, i As Integer, j As Integer

Set sh = Sheets("出库")

r = sh.Range("A1").CurrentRegion.Rows.Count

For i = 1 To Me.ListView_出库清单.ListItems.Count Step 1

Set iItem = Me.ListView_出库清单.ListItems(i)

sh.Cells(r + i, 1) = iItem.Text

For j = 1 To Me.ListView_出库清单.ColumnHeaders.Count - 1 Step 1

sh.Cells(r + i, j + 1) = iItem.SubItems(j)

Next j

Next i

bl = 生成出库单

If bl Then

MsgBox "出库单已生成"

End If

End Sub

Private Sub CommandButton_添加_Click()

Dim st, ans

Dim iItem As Object

st = Me.TextBox_出库单号.Text

If st = "" Then

MsgBox prompt:="出库单号不能为空，出库单号应为1~999", Buttons:=vbOKOnly + vbInformation, Title:="提示"

Call ODONumberUpdate '更新出库单号

Exit Sub

End If

If ODONumberIsExist Then

ans = MsgBox(prompt:="出库单号" & st & "已存在，建议更改为系统推荐单号，是否接受？", Buttons:=vbYesNo + vbQuestion, Title:="询问")

If ans = vbYes Then

ODONumberUpdate

Else

Me.TextBox_出库单号.SetFocus

Exit Sub

End If

'同一出库单，出库单号是否一致

If Me.ListView_出库清单.ListItems.Count > 0 Then

If VBA.Format(Me.ListView_出库清单.ListItems(1).Text, "yyyymmdd") <> VBA.Format(Me.DTPicker_出库日期.Value, "yyyymmdd") Then

MsgBox prompt:="出库日期不一致!", Buttons:=vbOKOnly + vbExclamation, Title:="警告"

Exit Sub

End If

If VBA.Right(Me.ListView_出库清单.ListItems(1).SubItems(1), 3) * 1 <> Me.TextBox_出库单号.Text * 1 Then

MsgBox prompt:="出库单号不一致!", Buttons:=vbOKOnly + vbExclamation, Title:="警告"

Exit Sub

End If

'记录要完整

If Me.TextBox_销售金额.Text = "" Then

MsgBox prompt:="出库信息不完整!", Buttons:=vbOKOnly + vbExclamation, Title:="警告"

Exit Sub

End If

Set iItem = Me.ListView_出库清单.ListItems.Add()

iItem.Text = VBA.Format(Me.DTPicker_出库日期.Value, "yyyy-mm-dd")

iItem.SubItems(1) = VBA.Format(Me.DTPicker_出库日期.Value, "yyyymmdd") & VBA.Format(Me.TextBox_出库单号.Text, "000")

iItem.SubItems(2) = Me.TextBox_商品代码.Text

iItem.SubItems(3) = Me.TextBox_商品名称.Text

iItem.SubItems(4) = Me.TextBox_型号.Text

iItem.SubItems(5) = Me.TextBox_销售数量.Text

iItem.SubItems(6) = Me.TextBox_销售单价.Text

iItem.SubItems(7) = Me.TextBox_销售金额.Text

End Sub

Private Sub DTPicker_出库日期_Change()

ODONumberUpdate '更新出库单号

End Sub

Private Sub Label_使用说明_Click()

End Sub

Private Sub ListView_出库清单_DblClick() '双击清空所有记录

Dim ans

ans = MsgBox(prompt:="确定要清空所有记录吗？", Buttons:=vbYesNo + vbQuestion, Title:="询问")

If ans = vbYes Then

Me.ListView_出库清单.ListItems.Clear

End If

End Sub

Private Sub ListView_出库清单_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)

If Button = 2 Then '按下鼠标右键

ans = MsgBox(prompt:="确定要删除此条记录吗？", Buttons:=vbYesNo + vbQuestion, Title:="询问")

If ans = vbYes Then

Me.ListView_出库清单.ListItems.Remove Me.ListView_出库清单.SelectedItem.Index

End If

End Sub

Private Sub SpinButton_出库单号_SpinDown()

Dim iODONumber As Integer

iODONumber = Me.TextBox_出库单号.Text * 1 - 1

If iODONumber < 1 Then

iODONumber = 1

End If

Me.TextBox_出库单号.Text = VBA.Format(iODONumber, "000")

End Sub

Private Sub SpinButton_出库单号_SpinUp()

Dim iODONumber As Integer

iODONumber = Me.TextBox_出库单号.Text * 1 + 1

If iODONumber > 999 Then

iODONumber = 999

End If

Me.TextBox_出库单号.Text = VBA.Format(iODONumber, "000")

End Sub

Private Sub TextBox_出库单号_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Dim iODONumber As Integer

'出库单号不能为空

If Me.TextBox_出库单号.Text = "" Then

MsgBox prompt:="出库单号不能为空，出库单号应为1~999", Buttons:=vbOKOnly + vbInformation, Title:="提示"

ODONumberUpdate '更新出库单号

Exit Sub

End If

'出库单号必须为数字

If VBA.IsNumeric(Me.TextBox_出库单号.Text) And Me.TextBox_出库单号.Text <> "" Then

Else

MsgBox prompt:="出库单号格式不正确，出库单号应为1~999", Buttons:=vbOKOnly + vbInformation, Title:="提示"

ODONumberUpdate '更新出库单号

Exit Sub

End If

'出库单号为整数

iODONumber = VBA.Int(Me.TextBox_出库单号.Text)

If iODONumber <> Me.TextBox_出库单号.Text * 1 Then

MsgBox prompt:="出库单号应为整数，出库单号应为1~999", Buttons:=vbOKOnly + vbInformation, Title:="提示"

ODONumberUpdate '更新出库单号

Exit Sub

End If

'出库单号范围1~999

If iODONumber < 1 Or iODONumber > 999 Then

MsgBox prompt:="出库单号超出范围，出库单号应为1~999", Buttons:=vbOKOnly + vbInformation, Title:="提示"

ODONumberUpdate '更新出库单号

Exit Sub

End If

Me.TextBox_出库单号.Text = VBA.Format(iODONumber, "000")

End Sub

Private Sub TextBox_商品代码_Change()

Dim f As Integer, iID

Dim iNode As Node

iID = Me.TextBox_商品代码.Text

f = 0

For Each iNode In Me.TreeView_价格表.Nodes

If VBA.Len(iID) > 1 And iID = iNode.Key Then

f = 1

Exit For

End If

Next iNode

If f = 1 Then

If VBA.Left(iNode.Key, 1) = "A" Then

Me.TextBox_商品名称.Text = "电视"

Me.TextBox_型号.Text = VBA.Right(iNode.Key, 3) * 1 & "寸"

ElseIf VBA.Left(iNode.Key, 1) = "B" Then

Me.TextBox_商品名称.Text = "洗衣机"

Me.TextBox_型号.Text = VBA.Right(iNode.Key, 3) * 1 & "升"

ElseIf VBA.Left(iNode.Key, 1) = "C" Then

Me.TextBox_商品名称.Text = "空调"

Me.TextBox_型号.Text = VBA.Right(iNode.Key, 3) * 1 & "匹"

End If

Me.TextBox_销售单价.Text = VBA.Split(iNode.Text, "：")(1)

If VBA.IsNumeric(Me.TextBox_销售数量) Then

Me.TextBox_销售金额.Text = VBA.Format(Me.TextBox_销售数量 * Me.TextBox_销售单价, "￥#,##0")

Else

Me.TextBox_销售数量.Text = ""

End If

Else

Me.TextBox_商品名称.Text = ""

Me.TextBox_型号.Text = ""

Me.TextBox_销售单价.Text = ""

Me.TextBox_销售金额.Text = ""

End If

End Sub

Private Sub TextBox_商品代码_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Me.MultiPage_多页框架.Value = 1

End Sub

Private Sub TextBox_商品代码_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Dim iID, f As Integer

Dim iNode As Node

iID = Me.TextBox_商品代码.Text

f = 0

For Each iNode In Me.TreeView_价格表.Nodes

If VBA.Len(iID) > 1 And iID = iNode.Key Then

f = 1

Exit For

End If

Next iNode

If f = 1 Then

If VBA.Left(iNode.Key, 1) = "A" Then

Me.TextBox_商品名称.Text = "电视"

Me.TextBox_型号.Text = VBA.Right(iNode.Key, 3) * 1 & "寸"

ElseIf VBA.Left(iNode.Key, 1) = "B" Then

Me.TextBox_商品名称.Text = "洗衣机"

Me.TextBox_型号.Text = VBA.Right(iNode.Key, 3) * 1 & "升"

ElseIf VBA.Left(iNode.Key, 1) = "C" Then

Me.TextBox_商品名称.Text = "空调"

Me.TextBox_型号.Text = VBA.Right(iNode.Key, 3) * 1 & "匹"

End If

Me.TextBox_销售单价.Text = VBA.Split(iNode.Text, "：")(1)

If VBA.IsNumeric(Me.TextBox_销售数量) Then

Me.TextBox_销售金额.Text = VBA.Format(Me.TextBox_销售数量 * Me.TextBox_销售单价, "￥#,##0")

Else

Me.TextBox_销售数量.Text = ""

End If

Else

If VBA.Len(iID) > 0 Then

MsgBox prompt:="此商品代码不存在", Buttons:=vbOKOnly + vbInformation, Title:="提示"

End If

Me.TextBox_商品名称.Text = ""

Me.TextBox_型号.Text = ""

Me.TextBox_销售单价.Text = ""

Me.TextBox_销售金额.Text = ""

End If

Set iNode = Nothing

End Sub

Private Sub TextBox_销售数量_Change()

If VBA.IsNumeric(Me.TextBox_销售数量.Text) Then

If Me.TextBox_销售单价.Text <> "" Then

Me.TextBox_销售金额.Text = VBA.Format(Me.TextBox_销售数量 * Me.TextBox_销售单价, "￥#,##0")

Else

Me.TextBox_销售金额.Text = ""

End If

Else

If VBA.Len(Me.TextBox_销售数量.Text) > 0 Then

MsgBox prompt:="销售数量格式不正确", Buttons:=vbOKOnly + vbInformation, Title:="提示"

End If

Me.TextBox_销售金额.Text = ""

End If

End Sub

Private Sub TreeView_价格表_NodeClick(ByVal Node As MSComctlLib.Node)

If VBA.Len(Node.Key) > 1 Then

Me.TextBox_商品代码.Text = Node.Key

Me.TextBox_商品名称.Text = Node.Parent.Text

If Node.Parent.Key = "A" Then

Me.TextBox_型号.Text = VBA.Right(Node.Key, 3) * 1 & "寸"

ElseIf Node.Parent.Key = "B" Then

Me.TextBox_型号.Text = VBA.Right(Node.Key, 3) * 1 & "升"

ElseIf Node.Parent.Key = "C" Then

Me.TextBox_型号.Text = VBA.Right(Node.Key, 3) * 1 & "匹"

End If

Me.TextBox_销售单价.Text = VBA.Split(Node.Text, "：")(1)

If VBA.IsNumeric(Me.TextBox_销售数量.Text) Then

Me.TextBox_销售金额.Text = VBA.Format(Me.TextBox_销售数量.Text * Me.TextBox_销售单价.Text, "￥#,##0")

Else

Me.TextBox_销售金额.Text = ""

End If

Me.MultiPage_多页框架.Value = 0

End Sub

'***************************更新出库单号 start *****************************

Sub ODONumberUpdate() '更新出库单号

Dim iDateODONumberArr

Dim imyDate, i As Integer

imyDate = VBA.Format(Me.DTPicker_出库日期.Value, "yyyymmdd")

iDateODONumberArr = DateODONumberArr(imyDate)

If VBA.IsArray(iDateODONumberArr) Then

i = Application.WorksheetFunction.Max(iDateODONumberArr) + 1

Else

i = 1

End If

Me.TextBox_出库单号.Text = VBA.Format(i, "000")

End Sub

Function DateODONumberArr(ByVal myDate) '某日已出库单号数组

Dim iODONumberArr, iDateODONumberArr

Dim sh As Worksheet, r As Integer

Dim i As Integer, ar

Set sh = Sheets("出库")

r = sh.Range("A1").CurrentRegion.Rows.Count

iODONumberArr = Application.WorksheetFunction.Transpose(sh.Range("B1").Resize(r, 1))

i = 0

For Each ar In iODONumberArr

If ar Like myDate & "###" Then

i = i + 1

If i = 1 Then

ReDim iDateODONumberArr(1 To i)

Else

ReDim iDateODONumberArr(1 To i)

End If

iDateODONumberArr(i) = VBA.Val(VBA.Right(ar, 3))

End If

Next ar

DateODONumberArr = iDateODONumberArr

End Function

'***************************更新出库单号 end *****************************

'***************************生成价格表 start *****************************

Sub PriceListTree()

Dim sh As Worksheet

Dim PriceListArr

Dim iRelative, iRelationShip, iKey, iText, iImage

Dim i As Integer

Dim iNode As Node

Set sh = Sheets("价格表")

PriceListArr = sh.Range("A1").CurrentRegion

Me.TreeView_价格表.ImageList = Me.ImageList_图标集

Me.TreeView_价格表.Nodes.Add , , "A", "电视", 1

Me.TreeView_价格表.Nodes.Add , , "B", "洗衣机", 3

Me.TreeView_价格表.Nodes.Add , , "C", "空调", 5

For i = 2 To UBound(PriceListArr, 1) Step 1

iRelative = VBA.Left(PriceListArr(i, 1), 1)

iRelationShip = tvwChild

iKey = PriceListArr(i, 1)

iText = PriceListArr(i, 1) & "(" & PriceListArr(i, 3) & ")" & "价格：" & VBA.Format(PriceListArr(i, 4), "￥#,##0")

If iRelative = "A" Then

iImage = 2

ElseIf iRelative = "B" Then

iImage = 4

ElseIf iRelative = "C" Then

iImage = 6

End If

Set iNode = Me.TreeView_价格表.Nodes.Add(iRelative, iRelationShip, iKey, iText, iImage)

iNode.EnsureVisible

Next i

End Sub

'***************************生成价格表 end *****************************

'***************************出库单号是否已存在 start *****************************

Function ODONumberIsExist() As Boolean

Dim bl As Boolean

Dim iODONumber, iODONumberArr

Dim r As Integer

Dim sh As Worksheet, f

iODONumber = VBA.Val(VBA.Format(Me.DTPicker_出库日期.Value, "yyyymmdd") & Me.TextBox_出库单号.Text)

Set sh = Sheets("出库")

r = sh.Range("A1").CurrentRegion.Rows.Count

iODONumberArr = Application.WorksheetFunction.Transpose(sh.Range("B1").Resize(r, 1))

On Error Resume Next

f = Application.WorksheetFunction.Match(iODONumber, iODONumberArr, 0)

If f = "" Then

bl = False

Else

bl = True

End If

ODONumberIsExist = bl

End Function

'***************************出库单号是否已存在 end *****************************

'***************************生成出库单 strart *****************************

Function 生成出库单() As Boolean

Dim sh As Worksheet, i As Integer, r As Integer

Set sh = Sheets("出库单")

r = sh.Range("B2").CurrentRegion.Rows.Count + 1

If r > 5 Then

sh.Range("A6").Resize(r - 5, 1).EntireRow.Delete

End If

If Me.ListView_出库清单.ListItems.Count = 0 Then

MsgBox prompt:="出库清单为空，不能打印", Buttons:=vbOKOnly + vbInformation, Title:="提示"

生成出库单 = False

Exit Function

End If

Set sh = Sheets("出库单")

sh.Range("C4") = Me.ListView_出库清单.ListItems(1).Text

sh.Range("F4") = Me.ListView_出库清单.ListItems(1).SubItems(1)

For i = 1 To Me.ListView_出库清单.ListItems.Count Step 1

sh.Cells(5 + i, 2) = Me.ListView_出库清单.ListItems(i).SubItems(2)

sh.Cells(5 + i, 3) = Me.ListView_出库清单.ListItems(i).SubItems(3)

sh.Cells(5 + i, 4) = Me.ListView_出库清单.ListItems(i).SubItems(4)

sh.Cells(5 + i, 5) = Me.ListView_出库清单.ListItems(i).SubItems(5)

sh.Cells(5 + i, 6) = Me.ListView_出库清单.ListItems(i).SubItems(6)

sh.Cells(5 + i, 7) = Me.ListView_出库清单.ListItems(i).SubItems(7)

Next i

r = sh.Range("B2").CurrentRegion.Rows.Count + 1

sh.Range("B6").Resize(r - 5, 6).Borders.LineStyle = xlContinuous '设置边框

生成出库单 = True

End Function

'***************************生成出库单 end *****************************

四、小程序下载

https://download.csdn.net/download/aaron19822007/85581241

vba编写的出库单（可添加出库项目记录、生成、打印出库单）相关推荐

android将项目添加到github,将github库作为依赖添加到Android-Studio项目中
将github库作为依赖添加到Android-Studio项目中我试图从https://github.com/chrisbanes/ActionBar-PullToRefresh/wiki/Quic ...
C语言：输入一个不多于5位的正整数，要求1：求出它是几位数; 要求2：分别打印出每一位数; 要求3：按逆序打印出各位数字;
/*输入一个不多于5位的正整数,要求1:求出它是几位数; 要求2:分别打印出每一位数; 要求3:按逆序打印出各位数字;*/#include <stdio.h> #include <m ...
习题 3.12 给出一个不多于5位的正整数，要求：1. 求出它是几位数；2. 分别打印出每一位数字；3. 按逆序打印出各位数字，例如原数位321，应输出123。
C++程序设计(第三版) 谭浩强习题3.12 个人设计习题 3.12 给出一个不多于5位的正整数,要求:1. 求出它是几位数:2. 分别打印出每一位数字:3. 按逆序打印出各位数字,例如原数位32 ...
平时各种常用的快捷键记录+快速打印出某文件夹下的子文件夹分布
目录 1. 实用Windows快捷键 2. cmd快捷键 3. chrome浏览器快捷键使用 4. PyCharm使用快捷键 5. PS快捷键 6. LabelImg快捷键快速打印出某文件夹下的子文 ...
php table表单下载,GitHub - Zerolone/auto: 用php生成表格、表单 phh create form table
auto form 用php生成表格.表单 php create form grid 想要实现的效果通过php生成html表单表格 info use php to create form grid ...
Python实现用户输入国家名称，打印出所输入的国家名称和首都。
该功能实现方案,利用Python中的字典来实现,python代码如下: ''' 编写程序,实现如下功能: • 用户输入国家名称: • 打印出所输入的国家名称和首都. '''country = {'中国 ...
qt中调用matlab生成的动态库
前言: 前面已经实现了在vc中调用matlab生成的动态库,请参考:vc中调用matlab生成的动态库现在在前面已经生成好的matlab动态库的基础上,在qt中调用matlab生成的动态库.生成ma ...
赵钱孙李称体重，按照由大到小的顺序，打印出四人的姓氏的首字母和体重数（中间用空格隔开，每人一行）
题目 - 称体重描述赵.钱.孙.李四个人中既有大人也有小孩,给他们称体重时发现,他们每个人的体重都不一样,且体重(单位:公斤)恰好是10的整数倍,且他们的体重都不高于50公斤,已知赵.钱两人的体重 ...
拼多多怎么批量打印电子面单步骤
拼多多目前是已经有了自己的电子面单系统了,所以拼多多商家就可以直接用平台上的电子面单了,目前商家打印拼多多电子面单就需要先开通拼多多电子面单系统了哦,同时拼多多的电子面单和其他平台的电子面单是一样的 ...
psm进销存管理系统、供应商管理、进货管理、销售管理、仓库管理、采购记录、库存盘点、调拨单、出库单、借入单、进货报表、采购记录、销售往来账、采购往来账、图表分析、人事管理、销售报表、财务报表、rp原型
psm进销存管理系统.供应商管理.进货管理.销售管理.仓库管理.采购记录.库存盘点.调拨单.出库单.借入单.进货报表.采购记录.销售往来账.采购往来账.图表分析.人事管理.销售报表.财务报表.rp原型 ...

vba编写的出库单（可添加出库项目记录、生成、打印出库单）

vba编写的出库单（可添加出库项目记录、生成、打印出库单）相关推荐

最新文章

热门文章