ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2019函数公式学习大典 不用妈妈陪默写神器 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2016实战技巧学习锦囊 WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 12611|回复: 29

[分享] 农场作物系统……Frame、ListView、Combobox、OptionButton、SpinButton控件综合运用

[复制链接]

TA的精华主题

TA的得分主题

发表于 2015-3-14 21:50 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:窗体
本帖最后由 Vicel 于 2015-3-14 21:52 编辑

玩农场的朋友,或许也曾经碰到过这样的问题:
1.某一农场作物是归属在哪一系列的呢?查一查?
2.神秘作物的挑战系列共有多少个系列呢?数一数?
3.未归类的其它作物都有哪些呢?列一列?


农场作物系统,能为你一一解答。
作物数据来源于QQ农场图鉴,系人工逐一录入,故不能保证所有信息正确无误。
本系统综合运用了Frame、ListView、Combobox、OptionButton、SpinButton、CheckBox等控件。有不足之处,请多多指教!
农场作物系统.zip (74.4 KB, 下载次数: 1225)

1.jpg
2.jpg
3.jpg
4.jpg
5.jpg
6.jpg
7.jpg
8.jpg
9.jpg
10.jpg


评分

3

查看全部评分

TA的精华主题

TA的得分主题

发表于 2015-3-15 08:37 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
虽然早就不玩农场了,但真心得赞一个。窗体综合应用示例应该能帮到很多人,楼主手工录入数据毅力可嘉

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-15 09:18 | 显示全部楼层
Moneky 发表于 2015-3-15 08:37
虽然早就不玩农场了,但真心得赞一个。窗体综合应用示例应该能帮到很多人,楼主手工录入数据毅力可嘉

谢谢您的支持!

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-15 11:31 | 显示全部楼层
QQ截图20150315112617.jpg
代码如下:
  1. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  2. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  3. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  4. Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
  5. Private Const WS_THICKFRAME As Long = &H40000       '(恢复大小)
  6. Private Const WS_MINIMIZEBOX As Long = &H20000      '(最小化)
  7. Private Const WS_MAXIMIZEBOX As Long = &H10000      '(最大化)
  8. Private Const GWL_STYLE = (-16)
  9. Dim ctl As Control           '窗体控件变量
  10. Dim pos As New Collection    '控件 位置比例参数
  11. Dim lng As New Collection    '控件 大小比例参数

  12. Private Sub CommandButton1_Click()
  13.     Me.Hide
  14.     UserForm3.Show 0
  15. End Sub

  16. Private Sub CommandButton2_Click()
  17.     Me.Hide
  18.     UserForm2.Show 0
  19. End Sub

  20. Sub XiLie_Click(Str)
  21.     Me.ListView1.ListItems.Clear
  22.     n = 0
  23.     For i = 2 To UBound(ar)
  24.         If CStr(ar(i, 4)) = Str Then
  25.             n = n + 1
  26.             With Me.ListView1.ListItems.Add()
  27.                 .Text = Format(n, "0000")
  28.                 For j = 1 To 5
  29.                     .SubItems(j) = ar(i, j)
  30.                 Next j
  31.             End With
  32.         End If
  33.     Next i
  34. End Sub

  35. Private Sub OptionButton1_Click()
  36.     Str = Me.OptionButton1.Caption
  37.     XiLie_Click (Str)
  38. End Sub

  39. Private Sub OptionButton2_Click()
  40.     Str = Me.OptionButton2.Caption
  41.     XiLie_Click (Str)
  42. End Sub

  43. Private Sub OptionButton3_Click()
  44.     Str = Me.OptionButton3.Caption
  45.     XiLie_Click (Str)
  46. End Sub

  47. Private Sub OptionButton4_Click()
  48.     Str = Me.OptionButton4.Caption
  49.     XiLie_Click (Str)
  50. End Sub

  51. Private Sub OptionButton5_Click()
  52.     Str = Me.OptionButton5.Caption
  53.     XiLie_Click (Str)
  54. End Sub

  55. Private Sub OptionButton6_Click()
  56.     Str = Me.OptionButton6.Caption
  57.     XiLie_Click (Str)
  58. End Sub

  59. Private Sub OptionButton7_Click()
  60.     Str = Me.OptionButton7.Caption
  61.     XiLie_Click (Str)
  62. End Sub

  63. Private Sub OptionButton8_Click()
  64.     Str = Me.OptionButton8.Caption
  65.     XiLie_Click (Str)
  66. End Sub

  67. Private Sub OptionButton9_Click()
  68.     Str = Me.OptionButton9.Caption
  69.     XiLie_Click (Str)
  70. End Sub

  71. Private Sub OptionButton10_Click()
  72.     Str = Me.OptionButton10.Caption
  73.     XiLie_Click (Str)
  74. End Sub

  75. Sub MyOptionButton_Click(Str)
  76.     If Me.OptionButton16.Value = False Then
  77.         Me.OptionButton15.Value = True
  78.         Str = Me.OptionButton15.Caption & "," & Str
  79.     Else
  80.         Str = Me.OptionButton16.Caption & "," & Str
  81.     End If
  82.     Me.SpinButton1.Value = 1
  83.     If InStr(d(Str), ":") > 0 Then
  84.         br = Split(d(Str), ":")
  85.         For i = 1 To 10
  86.             n = (Me.SpinButton1.Value - 1) * 10 + i
  87.             If n > UBound(br) + 1 Then
  88.                 Me.Controls("OptionButton" & i).Visible = False
  89.             Else
  90.                 Me.Controls("OptionButton" & i).Visible = True
  91.                 Me.Controls("OptionButton" & i).Caption = br(n - 1)
  92.             End If
  93.         Next i
  94.     Else
  95.         Me.OptionButton1.Visible = True
  96.         Me.OptionButton1.Caption = d(Str)
  97.     End If
  98.     Me.SpinButton1.Max = Application.RoundUp((UBound(br) + 1) / 10, 0)
  99.     Me.Label5.Caption = "第" & Me.SpinButton1.Value & "/" & Me.SpinButton1.Max & "页(" & UBound(br) + 1 & "个系列)"
  100.     If Me.OptionButton1.Value <> True Then
  101.         Me.OptionButton1.Value = True
  102.     Else
  103.         Me.OptionButton1.Value = False
  104.         Me.OptionButton1.Value = True
  105.     End If
  106. End Sub

  107. Private Sub OptionButton11_Click()
  108.     Str = Me.OptionButton11.Caption
  109.     MyOptionButton_Click (Str)
  110. End Sub

  111. Private Sub OptionButton12_Click()
  112.     Str = Me.OptionButton12.Caption
  113.     MyOptionButton_Click (Str)
  114. End Sub

  115. Private Sub OptionButton13_Click()
  116.     Str = Me.OptionButton13.Caption
  117.     MyOptionButton_Click (Str)
  118. End Sub

  119. Private Sub OptionButton14_Change()
  120.     If Me.OptionButton14.Value = True Then
  121.         Me.Frame3.Visible = False
  122.         Me.ListView1.Top = Me.ListView1.Top - Me.Frame3.Height
  123.         Me.ListView1.Height = Me.ListView1.Height + Me.Frame3.Height
  124.         If Me.OptionButton16.Value = False Then
  125.             Me.OptionButton15.Value = True
  126.             Str = Me.OptionButton15.Caption
  127.         Else
  128.             Str = Me.OptionButton16.Caption
  129.         End If
  130.         Me.ListView1.ListItems.Clear
  131.         n = 0
  132.         For i = 2 To UBound(ar)
  133.             If ar(i, 2) = Str And ar(i, 4) = "" Then
  134.                 n = n + 1
  135.                 With Me.ListView1.ListItems.Add()
  136.                     .Text = Format(n, "0000")
  137.                     For j = 1 To 5
  138.                         .SubItems(j) = ar(i, j)
  139.                     Next j
  140.                 End With
  141.             End If
  142.         Next i
  143.     Else
  144.         Me.ListView1.Height = Me.ListView1.Height - Me.Frame3.Height
  145.         Me.ListView1.Top = Me.ListView1.Top + Me.Frame3.Height
  146.         Me.Frame3.Visible = True
  147.     End If
  148. End Sub

  149. Private Sub OptionButton15_Click()
  150.     If Me.OptionButton11.Value = True Then Me.OptionButton11.Value = False
  151.     Me.OptionButton11.Value = True
  152. End Sub

  153. Private Sub OptionButton16_Click()
  154.     If Me.OptionButton11.Value = True Then Me.OptionButton11.Value = False
  155.     Me.OptionButton11.Value = True
  156. End Sub

  157. Private Sub SpinButton1_Change()
  158.     For i = 1 To 10
  159.         If Me.Controls("OptionButton" & i).Value = True Then
  160.             Me.Controls("OptionButton" & i).Value = False
  161.             Exit For
  162.         End If
  163.     Next i
  164.     For i = 1 To 10
  165.         n = (Me.SpinButton1.Value - 1) * 10 + i
  166.         If n > UBound(br) + 1 Then
  167.             Me.Controls("OptionButton" & i).Visible = False
  168.         Else
  169.             Me.Controls("OptionButton" & i).Visible = True
  170.             Me.Controls("OptionButton" & i).Caption = br(n - 1)
  171.         End If
  172.     Next i
  173.     Me.Label5.Caption = "第" & Me.SpinButton1.Value & "/" & Me.SpinButton1.Max & "页(" & UBound(br) + 1 & "个系列)"
  174. End Sub

  175. Private Sub UserForm_Activate()
  176.     Me.Label6.Caption = "系列:" & dd.Count
  177.     Me.Label7.Caption = "种类:" & UBound(ar) - 1
  178.     Me.Label8.Caption = "系列:" & Y
  179.     Me.Label9.Caption = "种类:" & X
  180.     Me.Label10.Caption = "系列:" & dd.Count - Y
  181.     Me.Label11.Caption = "种类:" & UBound(ar) - 1 - X
  182.     Me.OptionButton15.Value = True
  183.     If Me.OptionButton11.Value = False Then
  184.         Me.OptionButton11.Value = True
  185.     Else
  186.         MyOptionButton_Click (Me.OptionButton11.Caption)
  187.     End If
  188. End Sub

  189. Private Sub UserForm_Initialize()
  190.     Dim hWndForm As Long
  191.     Dim IStyle As Long
  192.     hWndForm = FindWindow("ThunderDFrame", Me.Caption)
  193.     IStyle = GetWindowLong(hWndForm, GWL_STYLE)
  194.     IStyle = IStyle Or WS_THICKFRAME       '还原
  195.     IStyle = IStyle Or WS_MINIMIZEBOX      '最小化
  196.     IStyle = IStyle Or WS_MAXIMIZEBOX      '最大化
  197.     SetWindowLong hWndForm, GWL_STYLE, IStyle
  198.    
  199.     Set ws = CreateObject("wscript.shell")
  200.     Set d = CreateObject("scripting.dictionary")
  201.     Set dd = CreateObject("scripting.dictionary")
  202.     Call Renew       '获取字典数据
  203.     With Me.ListView1
  204.         .ColumnHeaders.Add 1, , "序号", .Width * 14 / 150, 0
  205.         br = Array(.Width * 38.7 / 150, .Width * 24 / 150, .Width * 24 / 150, .Width * 30 / 150, .Width * 14 / 150)
  206.         For i = 1 To 5
  207.             .ColumnHeaders.Add i + 1, , ar(1, i), br(i - 1), 2
  208.         Next i
  209.     End With
  210.    
  211.     '利用集合记录各个控件与窗体比例的参数
  212.     For Each ctl In Me.Controls
  213.         pos.Add ctl.Left / Me.Width & " " & ctl.Top / Me.Height, ctl.Name
  214.         If ctl.Name <> "SpinButton1" Then
  215.             If ctl.Name = "ListView1" Then
  216.                 Str = ""
  217.                 For i = 1 To 6
  218.                     Str = Str & " " & ctl.ColumnHeaders(i).Width / Me.Width
  219.                 Next i
  220.                 lng.Add ctl.Width / Me.Width & " " & ctl.Height / Me.Height & " " & ctl.Font.Size / Me.Width & Str, ctl.Name
  221.             Else
  222.                 lng.Add ctl.Width / Me.Width & " " & ctl.Height / Me.Height & " " & ctl.Font.Size / Me.Width, ctl.Name
  223.             End If
  224.         Else
  225.             lng.Add ctl.Width / Me.Width & " " & ctl.Height / Me.Height, ctl.Name
  226.         End If
  227.     Next
  228. End Sub

  229. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  230.     Application.Visible = True
  231.     Set d = Nothing
  232.     Set dd = Nothing
  233.     Set rng = Nothing
  234.     Set ws = Nothing
  235.     ThisWorkbook.Save
  236.     If Application.Workbooks.Count = 1 Then
  237.         Application.Quit
  238.     Else
  239.         ThisWorkbook.Close
  240.     End If
  241. End Sub

  242. Private Sub UserForm_Resize()
  243.     For Each ctl In Me.Controls
  244.         '设置位置
  245.         ctl.Left = Me.Width * Val(Split(pos(ctl.Name))(0))
  246.         ctl.Top = Me.Height * Val(Split(pos(ctl.Name))(1))

  247.         '设置大小
  248.         If ctl.Name <> "SpinButton1" Then
  249.             If ctl.Name = "ListView1" Then
  250.                 ctl.Width = Me.Width * Val(Split(lng(ctl.Name))(0))
  251.                 ctl.Height = Me.Height * Val(Split(lng(ctl.Name))(1))
  252.                 'ctl.Font.Size = Me.Width * Val(Split(lng(ctl.Name))(2))
  253.                 For i = 1 To 6
  254.                     ctl.ColumnHeaders(i).Width = Me.Width * Val(Split(lng(ctl.Name))(i + 2))
  255.                 Next i
  256.             Else
  257.                 ctl.Width = Me.Width * Val(Split(lng(ctl.Name))(0))
  258.                 ctl.Height = Me.Height * Val(Split(lng(ctl.Name))(1))
  259.                 ctl.Font.Size = Me.Width * Val(Split(lng(ctl.Name))(2))
  260.             End If
  261.         Else
  262.             ctl.Width = Me.Width * Val(Split(lng(ctl.Name))(0))
  263.             ctl.Height = Me.Height * Val(Split(lng(ctl.Name))(1))
  264.         End If
  265.     Next
  266. End Sub
复制代码


TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-15 11:33 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
QQ截图20150315112708.jpg
  1. Private Sub CommandButton1_Click()
  2.     Unload Me
  3.     UserForm3.Show
  4. End Sub

  5. Private Sub CommandButton2_Click()
  6.     Unload Me
  7.     UserForm1.Show
  8. End Sub

  9. Private Sub OptionButton1_Click()
  10.     Me.TextBox1.Text = ""
  11.     Me.TextBox1.SetFocus
  12. End Sub

  13. Private Sub OptionButton2_Click()
  14.     Me.TextBox1.Text = ""
  15.     Me.TextBox1.SetFocus
  16. End Sub

  17. Private Sub TextBox1_Change()
  18.     TextBox_Change (1)
  19. End Sub

  20. Sub TextBox_Change(r)
  21.     Me.ListView1.ListItems.Clear
  22.     Str = Trim(Me.Controls("TextBox" & r).Text)
  23.     n = 0
  24.     If Me.OptionButton2.Value = True Then
  25.         If Str Like "*@*" Then
  26.             br = Split(Str, "@")
  27.             For i = 2 To UBound(ar)
  28.                 If ar(i, 2) Like "*" & br(0) & "*" And ar(i, 3) Like "*" & br(1) & "*" Then
  29.                     n = n + 1
  30.                     With Me.ListView1.ListItems.Add()
  31.                         .Text = Format(n, "0000")
  32.                         For j = 1 To 5
  33.                             .SubItems(j) = ar(i, j)
  34.                         Next j
  35.                     End With
  36.                 End If
  37.             Next i
  38.             Exit Sub
  39.         ElseIf Str Like "普通*" Or Str Like "神秘*" Then
  40.             s = 2
  41.         Else
  42.             s = 4
  43.         End If
  44.         GoTo 0
  45.     Else
  46.         s = 1
  47. 0:
  48.         For i = 2 To UBound(ar)
  49.             If ar(i, s) Like "*" & Str & "*" Then
  50.                 n = n + 1
  51.                 With Me.ListView1.ListItems.Add()
  52.                     .Text = Format(n, "0000")
  53.                     For j = 1 To 5
  54.                         .SubItems(j) = ar(i, j)
  55.                     Next j
  56.                 End With
  57.             End If
  58.         Next i
  59.     End If
  60. End Sub

  61. Private Sub UserForm_Activate()
  62.     Me.OptionButton1.Value = True
  63.     ar = ThisWorkbook.Sheets("Data").[A1].CurrentRegion
  64.     TextBox_Change (1)
  65. End Sub

  66. Private Sub UserForm_Initialize()
  67.     With Me.ListView1
  68.         .ColumnHeaders.Add 1, , "序号", .Width * 2.7 / 30, 0
  69.         br = Array(.Width * 7.8 / 30, .Width * 4.8 / 30, .Width * 4.8 / 30, .Width * 6 / 30, .Width * 2.8 / 30)
  70.         For i = 1 To 5
  71.             .ColumnHeaders.Add i + 1, , ar(1, i), br(i - 1), 2
  72.         Next i
  73.     End With
  74. End Sub

  75. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  76.     If CloseMode = 0 Then  '判断是否用窗体关闭按键来关闭窗口
  77.         Cancel = 1         '设置为除0以外的任意值,可以终止窗体的关闭,与closemode同时使用,可以达到让某种关闭方式失效
  78.         Me.Hide
  79.         UserForm1.Show
  80.     End If
  81. End Sub
复制代码


TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-15 11:35 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
QQ截图20150315112905.jpg
  1. Private Sub CheckBox1_Click()
  2.     If Me.CheckBox1.Value = False Then
  3.         With Me.TextBox1
  4.             .SelStart = 0
  5.             .SelLength = Len(.Text)
  6.             .SetFocus
  7.         End With
  8.     End If
  9. End Sub

  10. Private Sub ComboBox1_Change()
  11.     If Me.CommandButton1.Caption = "修 改" Then Exit Sub
  12.     With Me.ComboBox2
  13.         If Me.ComboBox1.Text <> "" Then
  14.             .Enabled = True
  15.             .BackColor = &H80000005
  16.         Else
  17.             .Text = ""
  18.             .Enabled = False
  19.             .BackColor = &H8000000B
  20.         End If
  21.     End With
  22. End Sub

  23. Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  24.     Select Case Me.ComboBox1.Text
  25.     Case "", "普通作物", "神秘作物"
  26.     Case Else
  27.         Me.ComboBox1.Text = ""
  28.         Cancel = True
  29.     End Select
  30. End Sub

  31. Private Sub ComboBox2_Change()
  32.     With Me.ComboBox3
  33.         If Me.ComboBox2.Text = "" Or Me.ComboBox2.Text = "其它" Then
  34.             .Text = ""
  35.             .Enabled = False
  36.             .BackColor = &H8000000B
  37.         Else
  38.             .Enabled = True
  39.             .BackColor = &H80000005
  40.             If Me.CommandButton1.Caption = "修 改" Then .Text = br(1, 4)
  41.         End If
  42.     End With
  43.     With Me.TextBox2
  44.         If Me.ComboBox2.Text = "" And Me.CommandButton1.Caption = "新 增" Then
  45.             .Text = ""
  46.             .Enabled = False
  47.             .BackColor = &H8000000B
  48.         ElseIf Me.ComboBox2.Text = "其它" Then
  49.             .Enabled = True
  50.             .BackColor = &H80000005
  51.         End If
  52.     End With
  53. End Sub

  54. Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  55.     Select Case Me.ComboBox2.Text
  56.     Case "", "简单系列", "一般系列", "挑战系列", "其它"
  57.     Case Else
  58.         Me.ComboBox2.Text = ""
  59.         Cancel = True
  60.     End Select
  61. End Sub

  62. Private Sub ComboBox3_Change()
  63.     If Me.CommandButton1.Caption = "修 改" Then Exit Sub
  64.     With Me.TextBox2
  65.         If Me.ComboBox3.Text <> "" Then
  66.             .Enabled = True
  67.             .BackColor = &H80000005
  68.         Else
  69.             .Text = ""
  70.             .Enabled = False
  71.             .BackColor = &H8000000B
  72.         End If
  73.     End With
  74. End Sub

  75. Private Sub ComboBox3_Enter()
  76.     Str = d(Me.ComboBox1.Text & "," & Me.ComboBox2.Text)
  77.     If InStr(Str, ":") > 0 Then
  78.         Me.ComboBox3.List = Split(Str, ":")
  79.     Else
  80.         Me.ComboBox3.AddItem Str
  81.     End If
  82. End Sub

  83. Private Sub CommandButton1_Click()
  84.     br = Array(Me.TextBox1.Text, Me.ComboBox1.Text, Me.ComboBox2.Text, Me.ComboBox3.Text, Me.TextBox2.Text)
  85.     If Me.CommandButton1.Caption = "修 改" Then
  86.         If br(0) = rng.Value Then
  87.             n = 0
  88.             For i = 1 To 4
  89.                 If br(i) <> rng.Offset(0, i).Text Then Exit For
  90.                 n = n + 1
  91.             Next i
  92.             If n = 4 Then
  93.                 ws.Popup "作物『" & br(0) & "』数据无变化,无须保存", 1, "信息", 64
  94.                 Exit Sub
  95.             End If
  96.             Str = "作物『" & br(0) & "』数据已更新"
  97.         Else
  98.             Str = "作物『" & rng.Value & "』数据已修改为" & "〖" & br(0) & "』"
  99.         End If
  100.         rng.Resize(1, 5) = br
  101.         ws.Popup Str, 1, "信息", 64
  102.         Set rng = Nothing
  103.         Me.CommandButton1.Caption = "新 增"
  104.     Else
  105.         Sheets("Data").Range("A65536").End(xlUp).Offset(1, 0).Resize(1, 5) = br
  106.         ws.Popup "作物『" & br(0) & "』数据已新增", 1, "信息", 64
  107.     End If
  108.     ThisWorkbook.Sheets("Data").Columns("A:E").Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlYes
  109.     Call Renew                '更新字典数据
  110.     Me.TextBox1.Text = ""
  111.     Me.TextBox1.SetFocus
  112. End Sub

  113. Private Sub CommandButton2_Click()
  114.     r = ws.Popup("是否删除该作物数据?", 2, "询问", 4 + 32)
  115.     If r = 6 Then
  116.         Str = "作物『" & rng.Value & "』数据已删除"
  117.         rng.EntireRow.Delete
  118.         Set rng = Nothing
  119.         ws.Popup Str, 1, "信息", 64
  120.         Call Renew                '更新字典数据
  121.         Me.TextBox1.Text = ""
  122.         Me.TextBox1.SetFocus
  123.     End If
  124. End Sub

  125. Private Sub CommandButton3_Click()
  126.     Me.Hide
  127.     UserForm1.Show
  128. End Sub

  129. Private Sub TextBox1_Change()
  130.     Me.TextBox1.Text = Trim(Me.TextBox1.Text)
  131.     If Me.TextBox1.Text = "" Then
  132.         Me.ComboBox1.Enabled = False
  133.         Me.ComboBox1.BackColor = &H8000000B
  134.         Me.CommandButton1.Enabled = False
  135.         GoTo 0
  136.     End If
  137.     If Me.CheckBox1.Value = False Then Exit Sub
  138.     If Me.TextBox1.Text <> "" Then
  139.         Me.ComboBox1.BackColor = &H80000005
  140.         Me.ComboBox1.Enabled = True
  141.         Set rng = ThisWorkbook.Sheets("Data").Range("A:A").Find(Me.TextBox1.Text, , , 1)
  142.         If Not rng Is Nothing Then
  143.             br = rng.Resize(1, 5)
  144.             For i = 1 To 3
  145.                 Me.Controls("Combobox" & i).Text = br(1, i + 1)
  146.             Next i
  147.             Me.TextBox2.Text = br(1, 5)
  148.             Me.CheckBox1.Enabled = True
  149.             Me.CommandButton1.Caption = "修 改"
  150.             Me.CommandButton2.Visible = True
  151.         Else
  152.             GoTo 0
  153.         End If
  154.     Else
  155. 0:
  156.         Me.CheckBox1.Value = True
  157.         Me.CheckBox1.Enabled = False
  158.         Me.CommandButton1.Caption = "新 增"
  159.         Me.CommandButton2.Visible = False
  160.         For i = 1 To 3
  161.             Me.Controls("Combobox" & i).Text = ""
  162.         Next i
  163.         Me.TextBox2.Text = ""
  164.     End If
  165. End Sub

  166. Private Sub TextBox2_Change()
  167.     Str = Me.TextBox2.Text
  168.     If Str = "" Then
  169.         Me.CommandButton1.Enabled = False
  170.     Else
  171.         For i = 1 To Len(Str)
  172.             temp = Mid(Str, i, 1)
  173.             Select Case temp
  174.             Case 0 To 9
  175.             Case Else
  176.                 Me.TextBox2.Text = Replace(Str, temp, "")
  177.             End Select
  178.         Next i
  179.         Me.TextBox2.Text = Application.Text(Me.TextBox2.Text, "0")
  180.         Me.CommandButton1.Enabled = True
  181.     End If
  182. End Sub

  183. Private Sub UserForm_Activate()
  184.     Me.TextBox1.Text = ""
  185.     Me.TextBox1.SetFocus
  186. End Sub

  187. Private Sub UserForm_Initialize()
  188.     Me.CheckBox1.Value = True
  189.     Me.CheckBox1.Enabled = False
  190.     Me.ComboBox1.List = Array("普通作物", "神秘作物")
  191.     Me.ComboBox2.List = Array("简单系列", "一般系列", "挑战系列", "其它")
  192. End Sub

  193. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  194.     If CloseMode = 0 Then  '判断是否用窗体关闭按键来关闭窗口
  195.         Cancel = 1         '设置为除0以外的任意值,可以终止窗体的关闭,与closemode同时使用,可以达到让某种关闭方式失效
  196.         Me.Hide
  197.         UserForm1.Show
  198.     End If
  199. End Sub
复制代码


TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-15 15:47 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
有朋友试用了吗?
有没有发现些什么问题?
或是能否给些建议呢?

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-16 13:26 | 显示全部楼层
预增加收集进度功能,有需要的朋友请冒个泡,继续关注本帖

TA的精华主题

TA的得分主题

发表于 2015-3-16 14:09 | 显示全部楼层
点赞先
——虽暂时无法测试程序,但看截图,应该是不错的作品。继英语单词助记工具之后,短短几天时间,楼主又出此新作,着实令人钦佩。

TA的精华主题

TA的得分主题

发表于 2015-3-21 17:16 | 显示全部楼层
VBA万岁 发表于 2015-3-16 14:09
点赞先
——虽暂时无法测试程序,但看截图,应该是不错的作品。继英语单词助记工具之后,短短几天时间,楼 ...

转换一下附件,回公司后再细看。 农场作物系统.zip (107.5 KB, 下载次数: 240)
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-19 17:46 , Processed in 0.059137 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表