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

Vicel

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


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

2015-3-14 21:46 上传

点击文件名下载附件

Moneky

虽然早就不玩农场了，但真心得赞一个。窗体综合应用示例应该能帮到很多人，楼主手工录入数据毅力可嘉

Vicel

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

谢谢您的支持！

Vicel

代码如下：

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. 
    
13. Private Sub CommandButton1_Click()
    
14.     Me.Hide
    
15.     UserForm3.Show 0
    
16. End Sub
    
17. 
    
18. Private Sub CommandButton2_Click()
    
19.     Me.Hide
    
20.     UserForm2.Show 0
    
21. End Sub
    
22. 
    
23. Sub XiLie_Click(Str)
    
24.     Me.ListView1.ListItems.Clear
    
25.     n = 0
    
26.     For i = 2 To UBound(ar)
    
27.         If CStr(ar(i, 4)) = Str Then
    
28.             n = n + 1
    
29.             With Me.ListView1.ListItems.Add()
    
30.                 .Text = Format(n, "0000")
    
31.                 For j = 1 To 5
    
32.                     .SubItems(j) = ar(i, j)
    
33.                 Next j
    
34.             End With
    
35.         End If
    
36.     Next i
    
37. End Sub
    
38. 
    
39. Private Sub OptionButton1_Click()
    
40.     Str = Me.OptionButton1.Caption
    
41.     XiLie_Click (Str)
    
42. End Sub
    
43. 
    
44. Private Sub OptionButton2_Click()
    
45.     Str = Me.OptionButton2.Caption
    
46.     XiLie_Click (Str)
    
47. End Sub
    
48. 
    
49. Private Sub OptionButton3_Click()
    
50.     Str = Me.OptionButton3.Caption
    
51.     XiLie_Click (Str)
    
52. End Sub
    
53. 
    
54. Private Sub OptionButton4_Click()
    
55.     Str = Me.OptionButton4.Caption
    
56.     XiLie_Click (Str)
    
57. End Sub
    
58. 
    
59. Private Sub OptionButton5_Click()
    
60.     Str = Me.OptionButton5.Caption
    
61.     XiLie_Click (Str)
    
62. End Sub
    
63. 
    
64. Private Sub OptionButton6_Click()
    
65.     Str = Me.OptionButton6.Caption
    
66.     XiLie_Click (Str)
    
67. End Sub
    
68. 
    
69. Private Sub OptionButton7_Click()
    
70.     Str = Me.OptionButton7.Caption
    
71.     XiLie_Click (Str)
    
72. End Sub
    
73. 
    
74. Private Sub OptionButton8_Click()
    
75.     Str = Me.OptionButton8.Caption
    
76.     XiLie_Click (Str)
    
77. End Sub
    
78. 
    
79. Private Sub OptionButton9_Click()
    
80.     Str = Me.OptionButton9.Caption
    
81.     XiLie_Click (Str)
    
82. End Sub
    
83. 
    
84. Private Sub OptionButton10_Click()
    
85.     Str = Me.OptionButton10.Caption
    
86.     XiLie_Click (Str)
    
87. End Sub
    
88. 
    
89. Sub MyOptionButton_Click(Str)
    
90.     If Me.OptionButton16.Value = False Then
    
91.         Me.OptionButton15.Value = True
    
92.         Str = Me.OptionButton15.Caption & "," & Str
    
93.     Else
    
94.         Str = Me.OptionButton16.Caption & "," & Str
    
95.     End If
    
96.     Me.SpinButton1.Value = 1
    
97.     If InStr(d(Str), ":") > 0 Then
    
98.         br = Split(d(Str), ":")
    
99.         For i = 1 To 10
    
100.             n = (Me.SpinButton1.Value - 1) * 10 + i
     
101.             If n > UBound(br) + 1 Then
     
102.                 Me.Controls("OptionButton" & i).Visible = False
     
103.             Else
     
104.                 Me.Controls("OptionButton" & i).Visible = True
     
105.                 Me.Controls("OptionButton" & i).Caption = br(n - 1)
     
106.             End If
     
107.         Next i
     
108.     Else
     
109.         Me.OptionButton1.Visible = True
     
110.         Me.OptionButton1.Caption = d(Str)
     
111.     End If
     
112.     Me.SpinButton1.Max = Application.RoundUp((UBound(br) + 1) / 10, 0)
     
113.     Me.Label5.Caption = "第" & Me.SpinButton1.Value & "/" & Me.SpinButton1.Max & "页(" & UBound(br) + 1 & "个系列)"
     
114.     If Me.OptionButton1.Value <> True Then
     
115.         Me.OptionButton1.Value = True
     
116.     Else
     
117.         Me.OptionButton1.Value = False
     
118.         Me.OptionButton1.Value = True
     
119.     End If
     
120. End Sub
     
121. 
     
122. Private Sub OptionButton11_Click()
     
123.     Str = Me.OptionButton11.Caption
     
124.     MyOptionButton_Click (Str)
     
125. End Sub
     
126. 
     
127. Private Sub OptionButton12_Click()
     
128.     Str = Me.OptionButton12.Caption
     
129.     MyOptionButton_Click (Str)
     
130. End Sub
     
131. 
     
132. Private Sub OptionButton13_Click()
     
133.     Str = Me.OptionButton13.Caption
     
134.     MyOptionButton_Click (Str)
     
135. End Sub
     
136. 
     
137. Private Sub OptionButton14_Change()
     
138.     If Me.OptionButton14.Value = True Then
     
139.         Me.Frame3.Visible = False
     
140.         Me.ListView1.Top = Me.ListView1.Top - Me.Frame3.Height
     
141.         Me.ListView1.Height = Me.ListView1.Height + Me.Frame3.Height
     
142.         If Me.OptionButton16.Value = False Then
     
143.             Me.OptionButton15.Value = True
     
144.             Str = Me.OptionButton15.Caption
     
145.         Else
     
146.             Str = Me.OptionButton16.Caption
     
147.         End If
     
148.         Me.ListView1.ListItems.Clear
     
149.         n = 0
     
150.         For i = 2 To UBound(ar)
     
151.             If ar(i, 2) = Str And ar(i, 4) = "" Then
     
152.                 n = n + 1
     
153.                 With Me.ListView1.ListItems.Add()
     
154.                     .Text = Format(n, "0000")
     
155.                     For j = 1 To 5
     
156.                         .SubItems(j) = ar(i, j)
     
157.                     Next j
     
158.                 End With
     
159.             End If
     
160.         Next i
     
161.     Else
     
162.         Me.ListView1.Height = Me.ListView1.Height - Me.Frame3.Height
     
163.         Me.ListView1.Top = Me.ListView1.Top + Me.Frame3.Height
     
164.         Me.Frame3.Visible = True
     
165.     End If
     
166. End Sub
     
167. 
     
168. Private Sub OptionButton15_Click()
     
169.     If Me.OptionButton11.Value = True Then Me.OptionButton11.Value = False
     
170.     Me.OptionButton11.Value = True
     
171. End Sub
     
172. 
     
173. Private Sub OptionButton16_Click()
     
174.     If Me.OptionButton11.Value = True Then Me.OptionButton11.Value = False
     
175.     Me.OptionButton11.Value = True
     
176. End Sub
     
177. 
     
178. Private Sub SpinButton1_Change()
     
179.     For i = 1 To 10
     
180.         If Me.Controls("OptionButton" & i).Value = True Then
     
181.             Me.Controls("OptionButton" & i).Value = False
     
182.             Exit For
     
183.         End If
     
184.     Next i
     
185.     For i = 1 To 10
     
186.         n = (Me.SpinButton1.Value - 1) * 10 + i
     
187.         If n > UBound(br) + 1 Then
     
188.             Me.Controls("OptionButton" & i).Visible = False
     
189.         Else
     
190.             Me.Controls("OptionButton" & i).Visible = True
     
191.             Me.Controls("OptionButton" & i).Caption = br(n - 1)
     
192.         End If
     
193.     Next i
     
194.     Me.Label5.Caption = "第" & Me.SpinButton1.Value & "/" & Me.SpinButton1.Max & "页(" & UBound(br) + 1 & "个系列)"
     
195. End Sub
     
196. 
     
197. Private Sub UserForm_Activate()
     
198.     Me.Label6.Caption = "系列：" & dd.Count
     
199.     Me.Label7.Caption = "种类：" & UBound(ar) - 1
     
200.     Me.Label8.Caption = "系列：" & Y
     
201.     Me.Label9.Caption = "种类：" & X
     
202.     Me.Label10.Caption = "系列：" & dd.Count - Y
     
203.     Me.Label11.Caption = "种类：" & UBound(ar) - 1 - X
     
204.     Me.OptionButton15.Value = True
     
205.     If Me.OptionButton11.Value = False Then
     
206.         Me.OptionButton11.Value = True
     
207.     Else
     
208.         MyOptionButton_Click (Me.OptionButton11.Caption)
     
209.     End If
     
210. End Sub
     
211. 
     
212. Private Sub UserForm_Initialize()
     
213.     Dim hWndForm As Long
     
214.     Dim IStyle As Long
     
215.     hWndForm = FindWindow("ThunderDFrame", Me.Caption)
     
216.     IStyle = GetWindowLong(hWndForm, GWL_STYLE)
     
217.     IStyle = IStyle Or WS_THICKFRAME       '还原
     
218.     IStyle = IStyle Or WS_MINIMIZEBOX      '最小化
     
219.     IStyle = IStyle Or WS_MAXIMIZEBOX      '最大化
     
220.     SetWindowLong hWndForm, GWL_STYLE, IStyle
     
221.    
     
222.     Set ws = CreateObject("wscript.shell")
     
223.     Set d = CreateObject("scripting.dictionary")
     
224.     Set dd = CreateObject("scripting.dictionary")
     
225.     Call Renew       '获取字典数据
     
226.     With Me.ListView1
     
227.         .ColumnHeaders.Add 1, , "序号", .Width * 14 / 150, 0
     
228.         br = Array(.Width * 38.7 / 150, .Width * 24 / 150, .Width * 24 / 150, .Width * 30 / 150, .Width * 14 / 150)
     
229.         For i = 1 To 5
     
230.             .ColumnHeaders.Add i + 1, , ar(1, i), br(i - 1), 2
     
231.         Next i
     
232.     End With
     
233.    
     
234.     '利用集合记录各个控件与窗体比例的参数
     
235.     For Each ctl In Me.Controls
     
236.         pos.Add ctl.Left / Me.Width & " " & ctl.Top / Me.Height, ctl.Name
     
237.         If ctl.Name <> "SpinButton1" Then
     
238.             If ctl.Name = "ListView1" Then
     
239.                 Str = ""
     
240.                 For i = 1 To 6
     
241.                     Str = Str & " " & ctl.ColumnHeaders(i).Width / Me.Width
     
242.                 Next i
     
243.                 lng.Add ctl.Width / Me.Width & " " & ctl.Height / Me.Height & " " & ctl.Font.Size / Me.Width & Str, ctl.Name
     
244.             Else
     
245.                 lng.Add ctl.Width / Me.Width & " " & ctl.Height / Me.Height & " " & ctl.Font.Size / Me.Width, ctl.Name
     
246.             End If
     
247.         Else
     
248.             lng.Add ctl.Width / Me.Width & " " & ctl.Height / Me.Height, ctl.Name
     
249.         End If
     
250.     Next
     
251. End Sub
     
252. 
     
253. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
     
254.     Application.Visible = True
     
255.     Set d = Nothing
     
256.     Set dd = Nothing
     
257.     Set rng = Nothing
     
258.     Set ws = Nothing
     
259.     ThisWorkbook.Save
     
260.     If Application.Workbooks.Count = 1 Then
     
261.         Application.Quit
     
262.     Else
     
263.         ThisWorkbook.Close
     
264.     End If
     
265. End Sub
     
266. 
     
267. Private Sub UserForm_Resize()
     
268.     For Each ctl In Me.Controls
     
269.         '设置位置
     
270.         ctl.Left = Me.Width * Val(Split(pos(ctl.Name))(0))
     
271.         ctl.Top = Me.Height * Val(Split(pos(ctl.Name))(1))
     
272. 
     
273.         '设置大小
     
274.         If ctl.Name <> "SpinButton1" Then
     
275.             If ctl.Name = "ListView1" Then
     
276.                 ctl.Width = Me.Width * Val(Split(lng(ctl.Name))(0))
     
277.                 ctl.Height = Me.Height * Val(Split(lng(ctl.Name))(1))
     
278.                 'ctl.Font.Size = Me.Width * Val(Split(lng(ctl.Name))(2))
     
279.                 For i = 1 To 6
     
280.                     ctl.ColumnHeaders(i).Width = Me.Width * Val(Split(lng(ctl.Name))(i + 2))
     
281.                 Next i
     
282.             Else
     
283.                 ctl.Width = Me.Width * Val(Split(lng(ctl.Name))(0))
     
284.                 ctl.Height = Me.Height * Val(Split(lng(ctl.Name))(1))
     
285.                 ctl.Font.Size = Me.Width * Val(Split(lng(ctl.Name))(2))
     
286.             End If
     
287.         Else
     
288.             ctl.Width = Me.Width * Val(Split(lng(ctl.Name))(0))
     
289.             ctl.Height = Me.Height * Val(Split(lng(ctl.Name))(1))
     
290.         End If
     
291.     Next
     
292. End Sub
     

复制代码

Vicel

1. Private Sub CommandButton1_Click()
   
2.     Unload Me
   
3.     UserForm3.Show
   
4. End Sub
   
5. 
   
6. Private Sub CommandButton2_Click()
   
7.     Unload Me
   
8.     UserForm1.Show
   
9. End Sub
   
10. 
    
11. Private Sub OptionButton1_Click()
    
12.     Me.TextBox1.Text = ""
    
13.     Me.TextBox1.SetFocus
    
14. End Sub
    
15. 
    
16. Private Sub OptionButton2_Click()
    
17.     Me.TextBox1.Text = ""
    
18.     Me.TextBox1.SetFocus
    
19. End Sub
    
20. 
    
21. Private Sub TextBox1_Change()
    
22.     TextBox_Change (1)
    
23. End Sub
    
24. 
    
25. Sub TextBox_Change(r)
    
26.     Me.ListView1.ListItems.Clear
    
27.     Str = Trim(Me.Controls("TextBox" & r).Text)
    
28.     n = 0
    
29.     If Me.OptionButton2.Value = True Then
    
30.         If Str Like "*@*" Then
    
31.             br = Split(Str, "@")
    
32.             For i = 2 To UBound(ar)
    
33.                 If ar(i, 2) Like "*" & br(0) & "*" And ar(i, 3) Like "*" & br(1) & "*" Then
    
34.                     n = n + 1
    
35.                     With Me.ListView1.ListItems.Add()
    
36.                         .Text = Format(n, "0000")
    
37.                         For j = 1 To 5
    
38.                             .SubItems(j) = ar(i, j)
    
39.                         Next j
    
40.                     End With
    
41.                 End If
    
42.             Next i
    
43.             Exit Sub
    
44.         ElseIf Str Like "普通*" Or Str Like "神秘*" Then
    
45.             s = 2
    
46.         Else
    
47.             s = 4
    
48.         End If
    
49.         GoTo 0
    
50.     Else
    
51.         s = 1
    
52. 0:
    
53.         For i = 2 To UBound(ar)
    
54.             If ar(i, s) Like "*" & Str & "*" Then
    
55.                 n = n + 1
    
56.                 With Me.ListView1.ListItems.Add()
    
57.                     .Text = Format(n, "0000")
    
58.                     For j = 1 To 5
    
59.                         .SubItems(j) = ar(i, j)
    
60.                     Next j
    
61.                 End With
    
62.             End If
    
63.         Next i
    
64.     End If
    
65. End Sub
    
66. 
    
67. Private Sub UserForm_Activate()
    
68.     Me.OptionButton1.Value = True
    
69.     ar = ThisWorkbook.Sheets("Data").[A1].CurrentRegion
    
70.     TextBox_Change (1)
    
71. End Sub
    
72. 
    
73. Private Sub UserForm_Initialize()
    
74.     With Me.ListView1
    
75.         .ColumnHeaders.Add 1, , "序号", .Width * 2.7 / 30, 0
    
76.         br = Array(.Width * 7.8 / 30, .Width * 4.8 / 30, .Width * 4.8 / 30, .Width * 6 / 30, .Width * 2.8 / 30)
    
77.         For i = 1 To 5
    
78.             .ColumnHeaders.Add i + 1, , ar(1, i), br(i - 1), 2
    
79.         Next i
    
80.     End With
    
81. End Sub
    
82. 
    
83. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    
84.     If CloseMode = 0 Then  '判断是否用窗体关闭按键来关闭窗口
    
85.         Cancel = 1         '设置为除0以外的任意值，可以终止窗体的关闭，与closemode同时使用，可以达到让某种关闭方式失效
    
86.         Me.Hide
    
87.         UserForm1.Show
    
88.     End If
    
89. End Sub
    

复制代码

Vicel

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. 
    
11. Private Sub ComboBox1_Change()
    
12.     If Me.CommandButton1.Caption = "修 改" Then Exit Sub
    
13.     With Me.ComboBox2
    
14.         If Me.ComboBox1.Text <> "" Then
    
15.             .Enabled = True
    
16.             .BackColor = &H80000005
    
17.         Else
    
18.             .Text = ""
    
19.             .Enabled = False
    
20.             .BackColor = &H8000000B
    
21.         End If
    
22.     End With
    
23. End Sub
    
24. 
    
25. Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
26.     Select Case Me.ComboBox1.Text
    
27.     Case "", "普通作物", "神秘作物"
    
28.     Case Else
    
29.         Me.ComboBox1.Text = ""
    
30.         Cancel = True
    
31.     End Select
    
32. End Sub
    
33. 
    
34. Private Sub ComboBox2_Change()
    
35.     With Me.ComboBox3
    
36.         If Me.ComboBox2.Text = "" Or Me.ComboBox2.Text = "其它" Then
    
37.             .Text = ""
    
38.             .Enabled = False
    
39.             .BackColor = &H8000000B
    
40.         Else
    
41.             .Enabled = True
    
42.             .BackColor = &H80000005
    
43.             If Me.CommandButton1.Caption = "修 改" Then .Text = br(1, 4)
    
44.         End If
    
45.     End With
    
46.     With Me.TextBox2
    
47.         If Me.ComboBox2.Text = "" And Me.CommandButton1.Caption = "新 增" Then
    
48.             .Text = ""
    
49.             .Enabled = False
    
50.             .BackColor = &H8000000B
    
51.         ElseIf Me.ComboBox2.Text = "其它" Then
    
52.             .Enabled = True
    
53.             .BackColor = &H80000005
    
54.         End If
    
55.     End With
    
56. End Sub
    
57. 
    
58. Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
59.     Select Case Me.ComboBox2.Text
    
60.     Case "", "简单系列", "一般系列", "挑战系列", "其它"
    
61.     Case Else
    
62.         Me.ComboBox2.Text = ""
    
63.         Cancel = True
    
64.     End Select
    
65. End Sub
    
66. 
    
67. Private Sub ComboBox3_Change()
    
68.     If Me.CommandButton1.Caption = "修 改" Then Exit Sub
    
69.     With Me.TextBox2
    
70.         If Me.ComboBox3.Text <> "" Then
    
71.             .Enabled = True
    
72.             .BackColor = &H80000005
    
73.         Else
    
74.             .Text = ""
    
75.             .Enabled = False
    
76.             .BackColor = &H8000000B
    
77.         End If
    
78.     End With
    
79. End Sub
    
80. 
    
81. Private Sub ComboBox3_Enter()
    
82.     Str = d(Me.ComboBox1.Text & "," & Me.ComboBox2.Text)
    
83.     If InStr(Str, ":") > 0 Then
    
84.         Me.ComboBox3.List = Split(Str, ":")
    
85.     Else
    
86.         Me.ComboBox3.AddItem Str
    
87.     End If
    
88. End Sub
    
89. 
    
90. Private Sub CommandButton1_Click()
    
91.     br = Array(Me.TextBox1.Text, Me.ComboBox1.Text, Me.ComboBox2.Text, Me.ComboBox3.Text, Me.TextBox2.Text)
    
92.     If Me.CommandButton1.Caption = "修 改" Then
    
93.         If br(0) = rng.Value Then
    
94.             n = 0
    
95.             For i = 1 To 4
    
96.                 If br(i) <> rng.Offset(0, i).Text Then Exit For
    
97.                 n = n + 1
    
98.             Next i
    
99.             If n = 4 Then
    
100.                 ws.Popup "作物『" & br(0) & "』数据无变化，无须保存", 1, "信息", 64
     
101.                 Exit Sub
     
102.             End If
     
103.             Str = "作物『" & br(0) & "』数据已更新"
     
104.         Else
     
105.             Str = "作物『" & rng.Value & "』数据已修改为" & "〖" & br(0) & "』"
     
106.         End If
     
107.         rng.Resize(1, 5) = br
     
108.         ws.Popup Str, 1, "信息", 64
     
109.         Set rng = Nothing
     
110.         Me.CommandButton1.Caption = "新 增"
     
111.     Else
     
112.         Sheets("Data").Range("A65536").End(xlUp).Offset(1, 0).Resize(1, 5) = br
     
113.         ws.Popup "作物『" & br(0) & "』数据已新增", 1, "信息", 64
     
114.     End If
     
115.     ThisWorkbook.Sheets("Data").Columns("A:E").Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlYes
     
116.     Call Renew                '更新字典数据
     
117.     Me.TextBox1.Text = ""
     
118.     Me.TextBox1.SetFocus
     
119. End Sub
     
120. 
     
121. Private Sub CommandButton2_Click()
     
122.     r = ws.Popup("是否删除该作物数据？", 2, "询问", 4 + 32)
     
123.     If r = 6 Then
     
124.         Str = "作物『" & rng.Value & "』数据已删除"
     
125.         rng.EntireRow.Delete
     
126.         Set rng = Nothing
     
127.         ws.Popup Str, 1, "信息", 64
     
128.         Call Renew                '更新字典数据
     
129.         Me.TextBox1.Text = ""
     
130.         Me.TextBox1.SetFocus
     
131.     End If
     
132. End Sub
     
133. 
     
134. Private Sub CommandButton3_Click()
     
135.     Me.Hide
     
136.     UserForm1.Show
     
137. End Sub
     
138. 
     
139. Private Sub TextBox1_Change()
     
140.     Me.TextBox1.Text = Trim(Me.TextBox1.Text)
     
141.     If Me.TextBox1.Text = "" Then
     
142.         Me.ComboBox1.Enabled = False
     
143.         Me.ComboBox1.BackColor = &H8000000B
     
144.         Me.CommandButton1.Enabled = False
     
145.         GoTo 0
     
146.     End If
     
147.     If Me.CheckBox1.Value = False Then Exit Sub
     
148.     If Me.TextBox1.Text <> "" Then
     
149.         Me.ComboBox1.BackColor = &H80000005
     
150.         Me.ComboBox1.Enabled = True
     
151.         Set rng = ThisWorkbook.Sheets("Data").Range("A:A").Find(Me.TextBox1.Text, , , 1)
     
152.         If Not rng Is Nothing Then
     
153.             br = rng.Resize(1, 5)
     
154.             For i = 1 To 3
     
155.                 Me.Controls("Combobox" & i).Text = br(1, i + 1)
     
156.             Next i
     
157.             Me.TextBox2.Text = br(1, 5)
     
158.             Me.CheckBox1.Enabled = True
     
159.             Me.CommandButton1.Caption = "修 改"
     
160.             Me.CommandButton2.Visible = True
     
161.         Else
     
162.             GoTo 0
     
163.         End If
     
164.     Else
     
165. 0:
     
166.         Me.CheckBox1.Value = True
     
167.         Me.CheckBox1.Enabled = False
     
168.         Me.CommandButton1.Caption = "新 增"
     
169.         Me.CommandButton2.Visible = False
     
170.         For i = 1 To 3
     
171.             Me.Controls("Combobox" & i).Text = ""
     
172.         Next i
     
173.         Me.TextBox2.Text = ""
     
174.     End If
     
175. End Sub
     
176. 
     
177. Private Sub TextBox2_Change()
     
178.     Str = Me.TextBox2.Text
     
179.     If Str = "" Then
     
180.         Me.CommandButton1.Enabled = False
     
181.     Else
     
182.         For i = 1 To Len(Str)
     
183.             temp = Mid(Str, i, 1)
     
184.             Select Case temp
     
185.             Case 0 To 9
     
186.             Case Else
     
187.                 Me.TextBox2.Text = Replace(Str, temp, "")
     
188.             End Select
     
189.         Next i
     
190.         Me.TextBox2.Text = Application.Text(Me.TextBox2.Text, "0")
     
191.         Me.CommandButton1.Enabled = True
     
192.     End If
     
193. End Sub
     
194. 
     
195. Private Sub UserForm_Activate()
     
196.     Me.TextBox1.Text = ""
     
197.     Me.TextBox1.SetFocus
     
198. End Sub
     
199. 
     
200. Private Sub UserForm_Initialize()
     
201.     Me.CheckBox1.Value = True
     
202.     Me.CheckBox1.Enabled = False
     
203.     Me.ComboBox1.List = Array("普通作物", "神秘作物")
     
204.     Me.ComboBox2.List = Array("简单系列", "一般系列", "挑战系列", "其它")
     
205. End Sub
     
206. 
     
207. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
     
208.     If CloseMode = 0 Then  '判断是否用窗体关闭按键来关闭窗口
     
209.         Cancel = 1         '设置为除0以外的任意值，可以终止窗体的关闭，与closemode同时使用，可以达到让某种关闭方式失效
     
210.         Me.Hide
     
211.         UserForm1.Show
     
212.     End If
     
213. End Sub
     

复制代码

Vicel

有朋友试用了吗？
有没有发现些什么问题？
或是能否给些建议呢？

Vicel

预增加收集进度功能，有需要的朋友请冒个泡，继续关注本帖

VBA万岁

点赞先
——虽暂时无法测试程序，但看截图，应该是不错的作品。继英语单词助记工具之后，短短几天时间，楼主又出此新作，着实令人钦佩。

VBA万岁

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

转换一下附件，回公司后再细看。 农场作物系统.zip (107.5 KB, 下载次数: 240)

2015-3-21 17:16 上传

点击文件名下载附件