您的位置: 首页  >  文章  >  VBA入门到进阶常用知识代码总结62

VBA入门到进阶常用知识代码总结62

分类: 文章 • 2024-10-02 15:56:40

第62集 窗体综合实例
300、 实现出库单输入并记录
VBA入门到进阶常用知识代码总结62
Option Explicit
'1 添加日期控件: 略

'2 出库单号码设置
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) '出库单号码强制输入，否则不允许离开
If TextBox2.Text = “” Then
Cancel = True '取消离开操作
End If
End Sub
Private Sub SpinButton1_SpinDown() '利用SpinDown事件和SpinUp事件改变出库单的号码
TextBox2.Text = Format(Val(TextBox2) + 1, “000”) '点击向下的按钮出库单号码在原来的基础上加1
End Sub
Private Sub SpinButton1_SpinUp()
TextBox2.Text = Format(Val(TextBox2) - 1, “000”) '点击向上的按钮出库单号码在原来的基础上减1
End Sub

'3 回车或点击按钮打开价格表窗口
Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
Me.MultiPage1.Value = 1
End If
End Sub
Private Sub CommandButton3_Click() '点击按钮打开单价窗口
Me.MultiPage1.Value = 1
End Sub

'4窗口加载表时完成treeview价格表导入和listview控件标题行生成
Private Sub UserForm_Initialize()
'Dim ITM As ListItem

ListView1.ColumnHeaders.Add 1, , “销售日期”, ListView1.Width / 8 '设置第1列
ListView1.ColumnHeaders.Add 2, , “出库单号”, ListView1.Width / 8, lvwColumnCenter '设置第2列
ListView1.ColumnHeaders.Add 3, , “商品代码”, ListView1.Width / 8, lvwColumnCenter '设置第3列
ListView1.ColumnHeaders.Add 4, , “商品名称”, ListView1.Width / 8, lvwColumnCenter '设置第4列
ListView1.ColumnHeaders.Add 5, , “型号”, ListView1.Width / 8, lvwColumnCenter '设置第5列
ListView1.ColumnHeaders.Add 6, , “销售数量”, ListView1.Width / 9, lvwColumnCenter '设置第6列
ListView1.ColumnHeaders.Add 7, , “销售单价”, ListView1.Width / 8, lvwColumnCenter '设置第7列
ListView1.ColumnHeaders.Add 8, , “销售金额”, ListView1.Width / 8, lvwColumnCenter '设置第8列
ListView1.View = lvwReport '设置为报告格式
ListView1.Gridlines = True '显示表格线
ListView1.FullRowSelect = True '可以选取整行
ListView1.MultiSelect = True
Call 添加Treeview数据
Me.MultiPage1.Value = 0 '显示输入界面
Me.MultiPage1.Style = 2 '隐藏选项卡
End Sub
Sub 添加Treeview数据()
Dim Nodx As Node
Dim arr, d As New Dictionary
Dim mykey, sr, x
TreeView1.ImageList = ImageList1 '从imagelist控件中提取图片
arr = Sheets(“价格表”).Range(“a2:D” & Sheets(“价格表”).Range(“a65535”).End(xlUp).Row)

For x = 1 To UBound(arr)
mykey = arr(x, 1) & “,” & arr(x, 2) & “,” & arr(x, 3) & “,” & arr(x, 4) '把商品所有信息连接起来,后面放在key里存放,以便随时调用
sr = arr(x, 3) & “(” & arr(x, 1) & “) 价格:” & arr(x, 4) '设置节点显示的内容
If Not d.Exists(arr(x, 2)) Then '如果该*节点不存在
d(arr(x, 2)) = “” '添加到字典里,以便下次判断是否存在
Set Nodx = TreeView1.Nodes.Add(, , arr(x, 2), arr(x, 2), 1, 1) '添加*节点
Set Nodx = TreeView1.Nodes.Add(arr(x, 2), tvwChild, mykey, sr, 2, 2) '添加子节点
Nodx.EnsureVisible '打开节点
Else
Set Nodx = TreeView1.Nodes.Add(arr(x, 2), tvwChild, mykey, sr, 2, 2) '添加子节点
End If
Next x
End Sub

'5 单击treeview或回车后,可以把选取的价格信息输入到相应的文本框中.然后焦点转到textbox5
Private Sub TreeView1_Click() '单击事件
TextBox3.Text = Split(Me.TreeView1.SelectedItem.Key, “,”)(0) '从key取出值折分开分别放在四个文本框内
TextBox4.Text = Split(Me.TreeView1.SelectedItem.Key, “,”)(1)
TextBox8.Text = Split(Me.TreeView1.SelectedItem.Key, “,”)(2)
TextBox6.Text = Split(Me.TreeView1.SelectedItem.Key, “,”)(3)
Me.MultiPage1.Value = 0
TextBox5.SetFocus
End Sub

Private Sub TreeView1_KeyDown(KeyCode As Integer, ByVal Shift As Integer) '按钮事件
If KeyCode = 13 Then
TextBox3.Text = Split(Me.TreeView1.SelectedItem.Key, “,”)(0) '从key取出值折分开分别放在四个文本框内
TextBox4.Text = Split(Me.TreeView1.SelectedItem.Key, “,”)(1)
TextBox8.Text = Split(Me.TreeView1.SelectedItem.Key, “,”)(2)
TextBox6.Text = Split(Me.TreeView1.SelectedItem.Key, “,”)(3)
Me.MultiPage1.Value = 0
TextBox5.SetFocus
End If
End Sub

'6 输入数量时自动计算金额,和输入后按回车添加到listview控件中
Private Sub TextBox5_Change()
TextBox7.Value = Val(TextBox5) * Val(TextBox6.Value) '输入数量时自动计算金额
End Sub

Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim lv As ListItem
If KeyCode = 13 And TextBox5 <> “” Then
'向listview中框添加记录
With ListView1
Set lv = .ListItems.Add
lv.Text = DTPicker1.Value
lv.SubItems(1) = TextBox2.Text
lv.SubItems(2) = TextBox3.Text
lv.SubItems(3) = TextBox4.Text
lv.SubItems(4) = TextBox8.Text
lv.SubItems(5) = TextBox5.Text
lv.SubItems(6) = TextBox6.Text
lv.SubItems(7) = TextBox7.Text
TextBox5 = “”
TextBox3 = “”
TextBox3.SetFocus
End With
End If
End Sub

'7 清空listview和删除选取的行
Private Sub ListView1_DblClick() '为listview控件增加清空所有行的功能
If MsgBox(“你要清空所有行吗”, vbOKCancel) = vbOK Then
ListView1.ListItems.Clear '用ListItems对象的clear方法可以清空所有行
End If
End Sub
Private Sub ListView1_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
If MsgBox(“你要删除选取的行吗”, vbOKCancel) = vbOK Then
ListView1.ListItems.Remove ListView1.SelectedItem.Index '用ListItems对象的clear方法可以清空所有行
End If
End If
End Sub

'8 把listview中的所有数据添加到出库表中.
Private Sub CommandButton1_Click() '把listview列表中的数据输出到工作表中
Dim arr()
Dim icount As Integer, y As Integer, x
icount = ListView1.ListItems.Count 'ListItems.Count 返回总行数
ReDim arr(1 To icount, 1 To 8)
For x = 1 To icount
arr(x, 1) = ListView1.ListItems(x).Text '把listview第1列(text）放在数组第一列
For y = 1 To 7
arr(x, y + 1) = ListView1.ListItems(x).SubItems(y)
Next y
Next x
Range(“a65536”).End(xlUp).Offset(1, 0).Resize(icount, 8) = arr
Me.ListView1.ListItems.Clear
TextBox2.Text = Format(Val(TextBox2) + 1, “000”)
TextBox3.SetFocus
TextBox3 = “”
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

相关推荐