怎样做保存/打印/查询功能

gohao123

各老师好！
我做了一个表单！请各位帮做一下功能！加上注释哦！我是新手！

怎样做保存/打印/查询功能


工程售后服务单 - 副本 (2).rar (105.21 KB, 下载次数: 32)

2012-12-5 20:52 上传

点击文件名下载附件

我试抄了一个！实现不了！！！


谢谢！

gohao123

还没老师过来看看。。。

gohao123

诚盼各位老师帮帮忙！！感谢了！！

mineshine

gohao123 发表于 2012-12-6 09:21
诚盼各位老师帮帮忙！！感谢了！！

我在繁体系统下写的
代码的中文如有乱码，请将代码复制黏贴。
ThisWorkBook里的代码:

1. 
   
2. Private Sub Workbook_Open()
   
3. Dim Sh As Worksheet
   
4. Set Sh = Sheet4
   
5.     Sheet1.Label1.Visible = False   '隠藏"工程服务单"Label1
   
6.     Set dic = CreateObject("scripting.dictionary")
   
7.     For i = 5 To Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
   
8.         If Not dic.exists(Sh.Cells(i, 2).Value & "") Then dic.Add Sh.Cells(i, 2).Value, ""  '查找不重复单号
   
9.     Next i
   
10.     With Sheet1.ComboBox1
    
11.         .Visible = True     '显示"工程服务单"ComboBox1
    
12.         .List = dic.keys    '将不重复单号写入ComboBox1组合清单
    
13.     End With
    
14.     Set dic = Nothing
    
15. End Sub
    

复制代码

mineshine

"工程服務單"的TextBox我刪除了
改用 Label 和 ComboBox替代
"工程服務單"里的代码

1. 
   
2. Private Sub CommandButton1_Click() '查询
   
3.     Dim Sh As Worksheet, i As Long
   
4.     Dim AB$, c As Object, fadd$, N
   
5.     Set Sh = Sheets("数据集")
   
6.     With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
   
7.         Set c = .Find(ComboBox1, LookIn:=xlValues, lookat:=xlWhole)
   
8.         If c Is Nothing Then
   
9.             MsgBox "找不到单号：" & [AB2], vbInformation + vbOKOnly
   
10.         Else
    
11.             [AB2] = c '单号
    
12.             [B6] = c.Offset(, 1) '客户
    
13.             [R6] = c.Offset(, 2) '地址
    
14.             [AC6] = c.Offset(, 3) '连络人/连糸方式
    
15.             [C7] = c.Offset(, 4) '项目名称
    
16.             [T7] = c.Offset(, 5) '机台编号
    
17.             [C8] = Year(c.Offset(, 7)) '制造年
    
18.             [F8] = Month(c.Offset(, 7)) '制造月
    
19.             [I8] = Day(c.Offset(, 7)) '制造日
    
20.             N = Split(c.Offset(, 8), " ~ ") '服务起止时间
    
21.             [Q8] = Year(N(0))   '年
    
22.             [T8] = Month(N(0))  '月
    
23.             [W8] = Day(N(0))    '日
    
24.             [Y8] = Hour(N(0))   '时
    
25.             [AA8] = Minute(N(0))    '分
    
26.             [AD8] = Month(N(1)) '月
    
27.             [AF8] = Day(N(1))   '日
    
28.             [AH8] = Hour(N(1))  '时
    
29.             [AJ8] = Minute(N(1))    '分
    
30.             [E10] = c.Offset(, 11) '故障现象
    
31.             [E13] = c.Offset(, 12)  '处理过程
    
32.             [E16] = c.Offset(, 13) '改善建议
    
33.             [AC19] = c.Offset(, 15) '其它
    
34.             [M20] = c.Offset(, 18) '其它補充
    
35.             [AA21] = c.Offset(, 19) '客户签名
    
36.             [AG21] = c.Offset(, 20) '服务人员
    
37.             [AG22] = c.Offset(, 21) '服务时间
    
38.             If c.Offset(, 6) = [AE7] Then   '服务类别
    
39.                 [AD7] = "■"
    
40.             Else
    
41.                 [AH7] = "■"
    
42.             End If
    
43.             If c.Offset(, 10) = [AD9] Then   '备件使用
    
44.                 [AC9] = "■"
    
45.             Else
    
46.                 [AH9] = "■"
    
47.             End If
    
48.             For i = 4 To 27
    
49.                 If c.Offset(, 9) = Cells(9, i) Then Cells(9, i - 1) = "■"      '服务类型
    
50.                 If c.Offset(, 14) = Cells(19, i) Then Cells(19, i - 1) = "■"   '服务工作结果
    
51.             Next i
    
52.             For i = 3 To 9 Step 2
    
53.                 If c.Offset(, 16) = Cells(20, i) Then Cells(21, i) = "ν"   '服务技能
    
54.                 If c.Offset(, 17) = Cells(20, i) Then Cells(22, i) = "ν"   '服务态度
    
55.             Next i
    
56.         End If
    
57.     End With
    
58. End Sub
    
59. 
    
60. Private Sub CommandButton2_Click() '新单
    
61.     Dim Sh As Worksheet
    
62.     Dim AB$, c As Object, fadd$, NO
    
63.     ComboBox1.Visible = False
    
64.     Label1.Visible = True
    
65.     Label1.Caption = "" '单号
    
66.     [C3,C4,AB2,E4,B6:N6,R6:V6,AC6:AK6,C7:O7,T7:Y7,C8:D8,F8:G8,I8,Q8:R8,T8:U8,W8,Y8,AA8,AD8,AF8,AH8,AJ8] = ""
    
67.     [E10:AK18,AC19:AK19,C21:I22,M20:Z22,AA21:AF22,AG21:AK21] = ""
    
68.     [AD7,AH7,C9,J9,K9,O9,R9,U9,AC9,AH9,D19,I19,O19,V19,Z19] = "□"
    
69.     Set Sh = Sheets("数据集")
    
70.     AB = "JC" & Format(Date, "yyyymmdd")
    
71.     With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
    
72.         Set c = .Find(AB, LookIn:=xlValues, lookat:=xlPart)
    
73.         If Not c Is Nothing Then
    
74.             fadd = c.Address
    
75.             Do
    
76.                 If Right(c, 5) > NO Then NO = Right(c, 5)
    
77.                 Set c = .FindNext(c)
    
78.             Loop While Not c Is Nothing And c.Address <> fadd
    
79.         Else
    
80.             NO = ""
    
81.         End If
    
82.     End With
    
83.     If NO = "" Then
    
84.         Label1.Caption = "JC" & Format(Date, "yyyymmdd") & "00001"    '新单编号
    
85.     Else
    
86.         Label1.Caption = AB & Format(NO + 1, "00000")
    
87.     End If
    
88.     [AB2] = Label1.Caption  'AB2单号
    
89.     CommandButton3.Enabled = True
    
90. End Sub
    
91. 
    
92. Private Sub CommandButton3_Click() '存储
    
93.     Dim Sh As Worksheet, r As Long, dic As Object, i As Long
    
94.     Dim D1, D2, ST$, SF$, SP4, SK$, SR$, SA$
    
95. 
    
96.     If [Z19] = "■" And [AC19] = "" Then
    
97.         MsgBox [Z20] & [A19] & "不可空白", vbInformation + vbOKCancel
    
98.         [AC19].Select
    
99.         Exit Sub
    
100.     End If
     
101.     If [AG21] = "" Then
     
102.         MsgBox [AG20] & "不可空白", vbInformation + vbOKCancel
     
103.         [AG21].Select
     
104.         Exit Sub
     
105.     End If
     
106.     If [AG22] = "" Then
     
107.         MsgBox "AG22请填写服务时间", vbInformation + vbOKCancel
     
108.         [AG22].Select
     
109.         Exit Sub
     
110.     End If
     
111.     Set Sh = Sheets("数据集")
     
112.     r = Sh.Cells(Sh.Rows.Count, 13).End(xlUp).Row + 1    '数据集M最后空白Row
     
113.     If [AD7] = "■" Then    '服务类别
     
114.         ST = [AD7]  '保固期
     
115.     Else
     
116.         ST = [AI7]  '非保固期
     
117.     End If
     
118.     D1 = [C8] & "/" & [F8] & "/" & [I8] '制造日期
     
119.     D2 = [Q8] & "/" & [T8] & "/" & [W8] & Space(1) & Format([Y8], "00") & ":" & Format([AA8], "00") & " ~ " & [Q8] & "/" & [AD8] & "/" & [AF8] & Space(1) & Format([AH8], "00") & ":" & Format([AJ8], "00") '服务起止时间
     
120.     For i = 3 To 21 'C9~U9
     
121.         If Cells(9, i) = "■" Then
     
122.             SF = Cells(9, i + 1)    '服务类型
     
123.             Exit For
     
124.         End If
     
125.     Next i
     
126.     If [AC9] = "■" Then    '备件使用
     
127.         SP = [AD9]  '免费提供
     
128.     Else
     
129.         SP = [AI9]  '收费提供
     
130.     End If
     
131.     For i = 4 To 26 'D19~Z19
     
132.         If Cells(19, i) = "■" Then
     
133.             SR = Cells(19, i + 1)    '服务工作结果
     
134.             Exit For
     
135.         End If
     
136.     Next i
     
137.     For i = 3 To 9 Step 2 'C21~I21
     
138.         If Cells(21, i) = "ν" Then
     
139.             SK = Cells(20, i)     '服务技能
     
140.             Exit For
     
141.         End If
     
142.     Next i
     
143.     For i = 3 To 9 Step 2 'C22~I22
     
144.         If Cells(22, i) = "ν" Then
     
145.             SA = Cells(20, i)    '服务态度
     
146.             Exit For
     
147.         End If
     
148.     Next i
     
149.     'NO,单号,客户,地址,连络人/连系方式,项目名称,机台编号,服务类别,制造日期,服获3起止时间,服务类型,备件使用,故障现象,处理过程,改善建议,服务工作结果,其它,服务技能,服务态度,其它补充,客户签名,服务人员,服务时间
     
150.     Sh.Cells(r, 1).Resize(, 23) = Array(r - 4, [AB2], [B6], [R6], [AC6], [C7], [T7], ST, D1, D2, SF, SP, [E10], [E13], [E16], SR, [AC19], SK, SA, [M20], [AA21], [AG21], [AG22])
     
151.     a = MsgBox("存储已完成，是否要清除" & Me.Name & "内容？", vbInformation + vbYesNo)
     
152.     If a = vbYes Then
     
153.         Label1.Caption = "" '清除Label
     
154.         [C3,C4,AB2,E4,B6:N6,R6:V6,AC6:AK6,C7:O7,T7:Y7,C8:D8,F8:G8,I8,Q8:R8,T8:U8,W8,Y8,AA8,AD8,AF8,AH8,AJ8] = ""
     
155.         [E10:AK18,AC19:AK19,C21:I22,M20:Z22,AA21:AF22,AG21:AK21] = ""
     
156.         [AD7,AH7,C9,J9,K9,O9,R9,U9,AC9,AH9,D19,I19,O19,V19,Z19] = "□"
     
157.     End If
     
158.     CommandButton3.Enabled = False      '隠藏"存储"按键
     
159.     Label1.Visible = False              '隠藏Label1
     
160.     Set dic = CreateObject("scripting.dictionary")
     
161.     For i = 5 To Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
     
162.         If Not dic.exists(Sh.Cells(i, 2).Value & "") Then dic.Add Sh.Cells(i, 2).Value, ""  '查找不重复单号
     
163.     Next i
     
164.     With ComboBox1
     
165.         .Visible = True     '显示ComboBox1
     
166.         .List = dic.keys    '将不重复单号写入ComboBox1组合清单
     
167.     End With
     
168.     Set dic = Nothing
     
169. End Sub
     
170. 
     
171. Private Sub CommandButton4_Click() '打印
     
172. Label1.Visible = False      '隠藏Lable1
     
173. ComboBox1.Visible = False   '隠藏ComboBox1
     
174. Application.Dialogs(xlDialogPrinterSetup).Show
     
175. Me.PageSetup.PrintArea = Range("A1:AL24").Address
     
176. With ActiveWindow.SelectedSheets
     
177.     .PrintPreview               'Preview工程服务单预览列印
     
178.     '.PrintOut Copies:=1 '打印，打印份数1
     
179. End With
     
180. ComboBox1.Visible = True    '显示Combobox1
     
181. End Sub
     
182. 
     
183. Private Sub CommandButton5_Click()  '查询修改
     
184.     Dim Sh As Worksheet, r As Long, dic As Object, i As Long
     
185.     Dim D1, D2, ST$, SF$, SP4, SK$, SR$, SA$
     
186.     Set Sh = Sheets("数据集")
     
187.     With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
     
188.         Set c = .Find(ComboBox1, LookIn:=xlValues, lookat:=xlWhole)
     
189.         If c Is Nothing Then
     
190.             MsgBox "找不到单号：" & [AB2], vbInformation + vbOKOnly
     
191.         Else
     
192.             If [Z19] = "■" And [AC19] = "" Then
     
193.                 MsgBox [Z20] & [A19] & "不可空白", vbInformation + vbOKCancel
     
194.                 [AC19].Select
     
195.                 Exit Sub
     
196.             End If
     
197.             If [AG21] = "" Then
     
198.                 MsgBox [AG20] & "不可空白", vbInformation + vbOKCancel
     
199.                 [AG21].Select
     
200.                 Exit Sub
     
201.             End If
     
202.             If [AG22] = "" Then
     
203.                 MsgBox "AG22请填写服务时间", vbInformation + vbOKCancel
     
204.                 [AG22].Select
     
205.                 Exit Sub
     
206.             End If
     
207.             Set Sh = Sheets("数据集")
     
208.             r = Sh.Cells(Sh.Rows.Count, 13).End(xlUp).Row + 1    '数据集M最后空白Row
     
209.             If [AD7] = "■" Then    '服务类别
     
210.                 ST = [AD7]  '保固期
     
211.             Else
     
212.                 ST = [AI7]  '非保固期
     
213.             End If
     
214.             D1 = [C8] & "/" & [F8] & "/" & [I8] '制造日期
     
215.             D2 = [Q8] & "/" & [T8] & "/" & [W8] & Space(1) & Format([Y8], "00") & ":" & Format([AA8], "00") & " ~ " & [Q8] & "/" & [AD8] & "/" & [AF8] & Space(1) & Format([AH8], "00") & ":" & Format([AJ8], "00") '服务起止时间
     
216.             For i = 3 To 21 'C9~U9
     
217.                 If Cells(9, i) = "■" Then
     
218.                     SF = Cells(9, i + 1)    '服务类型
     
219.                     Exit For
     
220.                 End If
     
221.             Next i
     
222.             If [AC9] = "■" Then    '备件使用
     
223.                 SP = [AD9]  '免费提供
     
224.             Else
     
225.                 SP = [AI9]  '收费提供
     
226.             End If
     
227.             For i = 4 To 26 'D19~Z19
     
228.                 If Cells(19, i) = "■" Then
     
229.                     SR = Cells(19, i + 1)    '服务工作结果
     
230.                     Exit For
     
231.                 End If
     
232.             Next i
     
233.             For i = 3 To 9 Step 2 'C21~I21
     
234.                 If Cells(21, i) = "ν" Then
     
235.                     SK = Cells(20, i)     '服务技能
     
236.                     Exit For
     
237.                 End If
     
238.             Next i
     
239.             For i = 3 To 9 Step 2 'C22~I22
     
240.                 If Cells(22, i) = "ν" Then
     
241.                     SA = Cells(20, i)    '服务态度
     
242.                     Exit For
     
243.                 End If
     
244.             Next i
     
245.             'NO,单号,客户,地址,连络人/连系方式,项目名称,机台编号,服务类别,制造日期,服获3起止时间,服务类型,备件使用,故障现象,处理过程,改善建议,服务工作结果,其它,服务技能,服务态度,其它补充,客户签名,服务人员,服务时间
     
246.             Sh.Cells(c.Row, 1).Resize(, 23) = Array(r - 4, [AB2], [B6], [R6], [AC6], [C7], [T7], ST, D1, D2, SF, SP, [E10], [E13], [E16], SR, [AC19], SK, SA, [M20], [AA21], [AG21], [AG22])
     
247.             a = MsgBox("存储已完成，是否要清除" & Me.Name & "内容？", vbInformation + vbYesNo)
     
248.             If a = vbYes Then
     
249.                 Label1.Caption = ""
     
250.                 [C3,C4,AB2,E4,B6:N6,R6:V6,AC6:AK6,C7:O7,T7:Y7,C8:D8,F8:G8,I8,Q8:R8,T8:U8,W8,Y8,AA8,AD8,AF8,AH8,AJ8] = ""
     
251.                 [E10:AK18,AC19:AK19,C21:I22,M20:Z22,AA21:AF22,AG21:AK21] = ""
     
252.                 [AD7,AH7,C9,J9,K9,O9,R9,U9,AC9,AH9,D19,I19,O19,V19,Z19] = "□"
     
253.             End If
     
254.             CommandButton3.Enabled = False
     
255.             Label1.Visible = False
     
256.             Set dic = CreateObject("scripting.dictionary")
     
257.             For i = 5 To Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
     
258.                 If Not dic.exists(Sh.Cells(i, 2).Value & "") Then dic.Add Sh.Cells(i, 2).Value, ""
     
259.             Next i
     
260.             With ComboBox1
     
261.                 .Visible = True
     
262.                 .List = dic.keys
     
263.             End With
     
264.             Set dic = Nothing
     
265.         End If
     
266.     End With
     
267. End Sub
     
268. 
     
269. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     
270.     If Target.Column = 17 And Target.Row > 7 And Target.Row < 12 Then
     
271.         Application.EnableEvents = False
     
272.         [q8:q11] = "↓"
     
273.         Target = "←"
     
274.         Application.EnableEvents = True
     
275.     End If
     
276. End Sub
     

复制代码

mineshine

我在繁体系统下写的
代码的中文如有乱码，请将代码复制黏贴。

参见附件

gohao123

谢谢楼上老师指点！功能不错！注释也很详细！但还有一点改动一下！附件中！有说明了！谢谢！

工程售后服务单 20121206-2.rar (134.79 KB, 下载次数: 19)

2012-12-6 22:08 上传

点击文件名下载附件

gohao123

查询只按单号（NO）查询！！

mineshine

gohao123 发表于 2012-12-6 21:57
谢谢楼上老师指点！功能不错！注释也很详细！但还有一点改动一下！附件中！有说明了！谢谢！

ThisWorkBook里的代码:

1. 
   
2. Private Sub Workbook_Open()
   
3. Dim Sh As Worksheet
   
4. Application.ScreenUpdating = False
   
5. Set Sh = Sheets("数据集")
   
6.     Sheet1.Label1.Visible = False   '隠藏"工程服务单"Label1
   
7.     Set dic = CreateObject("scripting.dictionary")
   
8.     For i = 5 To Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
   
9.         If Not dic.exists(Sh.Cells(i, 2).Value & "") Then dic.Add Sh.Cells(i, 2).Value, ""  '查找不重复单号
   
10.     Next i
    
11.     With Sheet1.ComboBox1   '单号
    
12.         .Value = ""
    
13.         .Visible = True     '显示"工程服务单"ComboBox1
    
14.         .List = dic.keys    '将不重复单号写入ComboBox1组合清单
    
15.     End With
    
16.     Set dic = Nothing
    
17.     Sheet1.Protect        '工作表保护
    
18. Application.ScreenUpdating = True
    
19. End Sub
    

复制代码

mineshine

"工程服務單"代码

1. Private Sub CommandButton1_Click() '查询
   
2.     Dim Sh As Worksheet, i As Long
   
3.     Dim AB$, c As Object, fadd$, N
   
4.     Application.ScreenUpdating = False
   
5.     ClearCells    '执行ClearCells清除栏位
   
6.     Me.Unprotect    '取消工作表保护
   
7.     ComboBox1.Visible = True
   
8.     Label1.Visible = False
   
9.     Set Sh = Sheets("数据集")
   
10.     With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
    
11.         Set c = .Find(ComboBox1, LookIn:=xlValues, lookat:=xlWhole)
    
12.         If c Is Nothing Then
    
13.             MsgBox "找不到单号：" & [AB2], vbInformation + vbOKOnly
    
14.         Else
    
15.             [AB2] = c '单号
    
16.             [B6] = c.Offset(, 1)            '客户
    
17.             [R6] = c.Offset(, 2)            '地址
    
18.             [AC6] = c.Offset(, 3)           '连络人/连络方式
    
19.             [C7] = c.Offset(, 4)            '项目名称
    
20.             [T7] = c.Offset(, 5)            '机台编号
    
21.             [C8] = Year(c.Offset(, 7))      '制造年
    
22.             [F8] = Month(c.Offset(, 7))     '制造月
    
23.             [I8] = Day(c.Offset(, 7))       '制造日
    
24.             N = Split(c.Offset(, 8), " ~ ") '分割服务起止时间
    
25.             [Q8] = Year(N(0))       '起年
    
26.             [T8] = Month(N(0))      '起月
    
27.             [W8] = Day(N(0))        '起日
    
28.             [Y8] = Hour(N(0))       '起时
    
29.             [AA8] = Minute(N(0))    '起分
    
30.             [AD8] = Month(N(1))     '止月
    
31.             [AF8] = Day(N(1))       '止日
    
32.             [AH8] = Hour(N(1))      '止时
    
33.             [AJ8] = Minute(N(1))    '止分
    
34.             [E10] = c.Offset(, 11) '故障现象
    
35.             [E13] = c.Offset(, 12)  '处理过程
    
36.             [E16] = c.Offset(, 13) '改善建议
    
37.             [AC19] = c.Offset(, 15) '其它
    
38.             [M20] = c.Offset(, 18) '其它補充
    
39.             [AA21] = c.Offset(, 19) '客户签名
    
40.             [AG21] = c.Offset(, 20) '服务人员
    
41.             [AG22] = c.Offset(, 21) '服务时间
    
42.             If c.Offset(, 6) = [AE7] Then   '服务类别
    
43.                 [AD7] = "■"
    
44.             Else
    
45.                 [AH7] = "■"
    
46.             End If
    
47.             If c.Offset(, 10) = [AD9] Then   '备件使用
    
48.                 [AC9] = "■"
    
49.             Else
    
50.                 [AH9] = "■"
    
51.             End If
    
52.             For i = 4 To 27
    
53.                 If i = 4 Or i = 8 Or i = 12 Or i = 16 Or i = 19 Or i = 22 Then
    
54.                     If c.Offset(, 9) = Cells(9, i) Then Cells(9, i - 1) = "■"      '服务类型
    
55.                 ElseIf i = 5 Or i = 10 Or i = 16 Or i = 23 Or i = 27 Then
    
56.                     If c.Offset(, 14) = Cells(19, i) Then Cells(19, i - 1) = "■"   '服务工作结果
    
57.                 End If
    
58.             Next i
    
59.             For i = 3 To 9 Step 2
    
60.                 If c.Offset(, 16) = Cells(20, i) Then Cells(21, i) = "ν"   '服务技能
    
61.                 If c.Offset(, 17) = Cells(20, i) Then Cells(22, i) = "ν"   '服务态度
    
62.             Next i
    
63.         End If
    
64.     End With
    
65.     Me.Protect        '工作表保护
    
66. Application.ScreenUpdating = True
    
67. End Sub
    
68. 
    
69. Private Sub CommandButton2_Click() '新单
    
70.     Dim Sh As Worksheet
    
71.     Dim AB$, c As Object, fadd$, NO
    
72.     ComboBox1.Visible = False
    
73.     Label1.Visible = True
    
74.     ClearCells    '执行ClearCells清除栏位
    
75.     Set Sh = Sheets("数据集")
    
76.     AB = "JC" & Format(Date, "yyyymmdd")
    
77.     With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
    
78.         Set c = .Find(AB, LookIn:=xlValues, lookat:=xlPart)
    
79.         If Not c Is Nothing Then
    
80.             fadd = c.Address
    
81.             Do
    
82.                 If Right(c, 5) > NO Then NO = Right(c, 5)
    
83.                 Set c = .FindNext(c)
    
84.             Loop While Not c Is Nothing And c.Address <> fadd
    
85.         Else
    
86.             NO = ""
    
87.         End If
    
88.     End With
    
89.     If NO = "" Then
    
90.         Label1.Caption = "JC" & Format(Date, "yyyymmdd") & "00001"    '新单编号
    
91.     Else
    
92.         Label1.Caption = AB & Format(NO + 1, "00000")
    
93.     End If
    
94.     Me.Unprotect    '取消工作表保护
    
95.     [AB2] = Label1.Caption  'AB2单号
    
96.     CommandButton3.Enabled = True
    
97. End Sub
    
98. 
    
99. Private Sub CommandButton3_Click() '存储
    
100.     Dim Sh As Worksheet, r As Long, dic As Object, i As Long
     
101.     Dim D1, D2, ST$, SF$, SP4, SK$, SR$, SA$
     
102.     If [Z19] = "■" And [AC19] = "" Then     '服务工作结果：其他
     
103.         MsgBox [Z20] & [A19] & "不可空白", vbInformation + vbOKCancel
     
104.         [AC19].Select
     
105.         Exit Sub
     
106.     ElseIf [AC19] <> "" Then
     
107.         [Z19] = "■"
     
108.         For i = 4 To 22
     
109.             If i = 4 Or i = 9 Or i = 15 Or i = 22 Then Cells(19, i) = "□"
     
110.         Next i
     
111.     End If
     
112.     If [AG21] = "" Then
     
113.         MsgBox [AG20] & "不可空白", vbInformation + vbOKCancel
     
114.         [AG21].Select
     
115.         Exit Sub
     
116.     End If
     
117.     If [AG22] = "" Then
     
118.         MsgBox "AG22请填写服务时间", vbInformation + vbOKCancel
     
119.         [AG22].Select
     
120.         Exit Sub
     
121.     End If
     
122.     Set Sh = Sheets("数据集")
     
123.     r = Sh.Cells(Sh.Rows.Count, 13).End(xlUp).Row + 1    '数据集M最后空白Row
     
124.     If [AD7] = "■" Then    '服务类别
     
125.         ST = [AE7]  '保固期
     
126.     Else
     
127.         ST = [AI7]  '非保固期
     
128.     End If
     
129.     D1 = [C8] & "/" & [F8] & "/" & [I8] '制造日期
     
130.     D2 = Format([Q8], "0000") & "/" & Format([T8], "00") & "/" & Format([W8], "00") & Space(1) & Format([Y8], "00") & ":" & Format([AA8], "00") & _
     
131.          " ~ " & Format([Q8], "0000") & "/" & Format([AD8], "00") & "/" & Format([AF8], "00") & Space(1) & Format([AH8], "00") & ":" & Format([AJ8], "00") '服务起止时间
     
132.     For i = 3 To 21 'C9~U9
     
133.         If Cells(9, i) = "■" Then
     
134.             SF = Cells(9, i + 1)    '服务类型
     
135.             Exit For
     
136.         End If
     
137.     Next i
     
138.     If [AC9] = "■" Then    '备件使用
     
139.         SP = [AD9]  '免费提供
     
140.     Else
     
141.         SP = [AI9]  '收费提供
     
142.     End If
     
143.     For i = 4 To 26 'D19~Z19
     
144.         If Cells(19, i) = "■" Then
     
145.             SR = Cells(19, i + 1)    '服务工作结果
     
146.             Exit For
     
147.         End If
     
148.     Next i
     
149.     For i = 3 To 9 Step 2 'C21~I21
     
150.         If Cells(21, i) = "ν" Then
     
151.             SK = Cells(20, i)     '服务技能
     
152.             Exit For
     
153.         End If
     
154.     Next i
     
155.     For i = 3 To 9 Step 2 'C22~I22
     
156.         If Cells(22, i) = "ν" Then
     
157.             SA = Cells(20, i)    '服务态度
     
158.             Exit For
     
159.         End If
     
160.     Next i
     
161.     With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
     
162.         Set c = .Find(ComboBox1, LookIn:=xlValues, lookat:=xlWhole)
     
163.         If c Is Nothing Then
     
164.             'NO,单号,客户,地址,连络人/连系方式,项目名称,机台编号,服务类别,制造日期,服务起止时间,服务类型,备件使用,故障现象,处理过程,改善建议,服务工作结果,其它,服务技能,服务态度,其它补充,客户签名,服务人员,服务时间
     
165.             Sh.Cells(r, 1).Resize(, 23) = Array(r - 4, [AB2], [B6], [R6], [AC6], [C7], [T7], ST, D1, D2, SF, SP, [E10], [E13], [E16], SR, [AC19], SK, SA, [M20], [AA21], [AG21], [AG22])
     
166.         Else
     
167.             Sh.Cells(c.Row, 1).Resize(, 23) = Array(r - 4, [AB2], [B6], [R6], [AC6], [C7], [T7], ST, D1, D2, SF, SP, [E10], [E13], [E16], SR, [AC19], SK, SA, [M20], [AA21], [AG21], [AG22])
     
168.         End If
     
169.     End With
     
170.     a = MsgBox("存储已完成，是否要清除" & Me.Name & "内容？", vbInformation + vbYesNo)
     
171.     If a = vbYes Then ClearCells    '执行ClearCells清除栏位
     
172.     CommandButton3.Enabled = False      '隠藏"存储"按键
     
173.     Label1.Visible = False              '隠藏Label1
     
174.     Set dic = CreateObject("scripting.dictionary")
     
175.     For i = 5 To Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
     
176.         If Not dic.exists(Sh.Cells(i, 2).Value & "") Then dic.Add Sh.Cells(i, 2).Value, ""  '查找不重复单号
     
177.     Next i
     
178.     With ComboBox1
     
179.         .Visible = True     '显示ComboBox1
     
180.         .List = dic.keys    '将不重复单号写入ComboBox1组合清单
     
181.     End With
     
182.     Set dic = Nothing
     
183.     Me.Protect        '工作表保护
     
184. End Sub
     
185. 
     
186. Private Sub CommandButton4_Click() '打印
     
187. Label1.Visible = False      '隠藏Lable1
     
188. ComboBox1.Visible = False   '隠藏ComboBox1
     
189. Application.Dialogs(xlDialogPrinterSetup).Show
     
190. Me.PageSetup.PrintArea = Range("A1:AL24").Address   '打印范围
     
191. With ActiveWindow.SelectedSheets
     
192.     .PrintPreview               'Preview工程服务单预览列印
     
193.     '.PrintOut Copies:=1 '打印，打印份数1
     
194. End With
     
195. ComboBox1.Visible = True    '显示Combobox1
     
196. End Sub
     
197. 
     
198. Private Sub CommandButton5_Click()  '查询修改
     
199.     Dim Sh As Worksheet, r As Long, dic As Object, i As Long
     
200.     Dim D1, D2, ST$, SF$, SP4, SK$, SR$, SA$
     
201.     CommandButton3.Enabled = True    '"存储"按键激活
     
202.     Me.Unprotect  '取消工作表保护
     
203. End Sub
     
204. 
     
205. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     
206. Dim Rng$, i%
     
207.     If Me.ProtectContents = True Then
     
208.         [C8,Q8,F8,T8,AD8,I8,W8,AF8,Y8,AH8,AA8,AJ8].Validation.Delete
     
209.         Exit Sub    '如果工作表视窗处于保护状态就不执行触发事件
     
210.     Else
     
211.         If CommandButton3.Enabled = True Then  '当"存储"按键可用时
     
212.             Rng = ""
     
213.             If Target.Row = 8 Then  '制造日期, 服务起止时间
     
214.                 If Target.Address = "$C$8:$D$8" Or Target.Address = "$Q$8:$R$8" Then
     
215.                     For i = Year(Date) To Year(Date) + 10   '年
     
216.                         Rng = Rng & "," & i
     
217.                     Next i
     
218.                 ElseIf Target.Address = "$F$8:$G$8" Or Target.Address = "$T$8:$U$8" Or Target.Address = "$AD$8" Then
     
219.                     For i = 1 To 12     '月
     
220.                         Rng = Rng & "," & i
     
221.                     Next i
     
222.                 ElseIf Target.Address = "$I$8" Or Target.Address = "$W$8" Or Target.Address = "$AF$8" Then
     
223.                     D = Day(DateSerial(Target.Offset(, -6), Target.Offset(, -3) + 1, 1) - 1)
     
224.                     For i = 1 To D     '日
     
225.                         Rng = Rng & "," & i
     
226.                     Next i
     
227.                 ElseIf Target.Address = "$Y$8" Or Target.Address = "$AH$8" Then
     
228.                     For i = 0 To 23     '时
     
229.                         Rng = Rng & "," & i
     
230.                     Next i
     
231.                 ElseIf Target.Address = "$AA$8" Or Target.Address = "$AJ$8" Then
     
232.                     For i = 0 To 59     '分
     
233.                         Rng = Rng & "," & i
     
234.                     Next i
     
235.                 End If
     
236.                 Rng = Mid(Rng, 2)
     
237.                 Target.Validation.Delete
     
238.                 Target.Validation.Add 3, 1, 1, Rng '数据有效性
     
239.             End If
     
240.             If Target.Address = "$AD$7" Or Target.Address = "$AH$7" Then    '服务类别
     
241.                 If [AD7] = "□" Then
     
242.                     [AD7] = "■"    '保固期
     
243.                     [AH7] = "□"    '非保固期
     
244.                 Else
     
245.                     [AD7] = "□"    '保固期
     
246.                     [AH7] = "■"    '非保固期
     
247.                 End If
     
248.             End If
     
249.             If Target.Address = "$AC$9" Or Target.Address = "$AH$9" Then    '备件使用
     
250.                 If [AC9] = "□" Then
     
251.                     [AC9] = "■"    '免费提供
     
252.                     [AH9] = "□"    '收费提供
     
253.                 Else
     
254.                     [AC9] = "□"    '免费提供
     
255.                     [AH9] = "■"    '收费提供
     
256.                 End If
     
257.             End If
     
258.             If Target.Row = 9 And (Target.Column = 3 Or Target.Column = 7 Or Target.Column = 11 Or Target.Column = 15 Or Target.Column = 18 Or Target.Column = 21) Then '服务类型
     
259.                 If Target = "□" Then
     
260.                     Target = "■"
     
261.                     t = Target.Column
     
262.                 Else
     
263.                     Target = "□"
     
264.                     Exit Sub
     
265.                 End If
     
266.                 For i = 3 To 21 'C9,G9,K9,O9,,R9,U9
     
267.                     If i = 3 Or i = 7 Or i = 11 Or i = 15 Or i = 18 Or i = 21 Then If i <> t And Cells(9, i) = "■" Then Cells(9, i) = "□"
     
268.                 Next i
     
269.             End If
     
270.             If Target.Row = 19 And (Target.Column = 4 Or Target.Column = 9 Or Target.Column = 15 Or Target.Column = 18 Or Target.Column = 22 Or Target.Column = 26) Then '服务工作结果
     
271.                 If Target = "□" Then
     
272.                     Target = "■"
     
273.                     t = Target.Column
     
274.                 Else
     
275.                     Target = "□"
     
276.                     Exit Sub
     
277.                 End If
     
278.                 If Target.Address <> "$Z$19" Then [AC19] = ""   '选择非"其它",[AC19]清空
     
279.                 For i = 4 To 26 'D19,I19,O1,V19,,Z19
     
280.                     If i = 4 Or i = 9 Or i = 15 Or i = 18 Or i = 22 Or i = 26 Then If i <> t And Cells(19, i) = "■" Then Cells(19, i) = "□"
     
281.                 Next i
     
282.             End If
     
283.             If Target.Row = 21 Or Target.Row = 22 And (Target.Column > 2 And Target.Column < 10) Then '客户评价
     
284.                 If Cells(Target.Row, Target.Column) = "ν" Then
     
285.                     'Target = "ν"
     
286.                     t = Target.Column
     
287.                 Else
     
288.                     Target = "ν"
     
289.                     t = Target.Column
     
290.                 End If
     
291.                 For i = 3 To 9 Step 2
     
292.                     If i <> t And Cells(Target.Row, i) = "ν" Then Cells(Target.Row, i) = ""
     
293.                 Next i
     
294.             End If
     
295.         Else
     
296.             [C8,Q8,F8,T8,AD8,I8,W8,AF8,Y8,AH8,AA8,AJ8].Validation.Delete
     
297.         End If
     
298.     End If
     
299. End Sub
     
300. 
     
301. Sub ClearCells()
     
302.     With Sheet1
     
303.         .Unprotect
     
304.         .Label1.Caption = "" '清除Label
     
305.         .[AB2:AK2,B6:N6,R6:V6,AC6:AK6,C7:O7,T7:Y7,C8:D8,F8:G8,I8,Q8:R8,T8:U8,W8,Y8,AA8,AD8,AF8,AH8,AJ8] = ""
     
306.         .[E10:AK18,AC19:AK19,C21:I22,M20:Z22,AA21:AF22,AG21:AK21,AG22:AK22] = ""
     
307.         .[AD7,AH7,C9,G9,K9,O9,R9,U9,AC9,AH9,D19,I19,O19,V19,Z19] = "□"
     
308.     End With
     
309. End Sub

复制代码