ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 6659|回复: 24

[分享] 农场作物系统……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, 下载次数: 808)

评分

参与人数 2鲜花 +6 收起 理由
达州张先生 + 3 太强大了
VBA万岁 + 3

查看全部评分

TA的精华主题

TA的得分主题

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

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 "use*****" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  2. Private Declare Function SetWindowLong Lib "use*****" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  3. Private Declare Function FindWindow Lib "use*****" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  4. Private Declare Function ShowWindow Lib "use*****" (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 | 显示全部楼层
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 | 显示全部楼层
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 | 显示全部楼层
有朋友试用了吗?
有没有发现些什么问题?
或是能否给些建议呢?

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, 下载次数: 191)
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

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

GMT+8, 2019-8-24 02:13 , Processed in 0.101585 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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