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

mineshine · 发表于 2012-12-7 15:55

製造日期、服務起止時間单元格改用数据有效性

如果你还要再更改模板
我的代码注解很详细
你可以自行修改

gohao123 · 发表于 2012-12-7 17:02

谢谢！{:soso_e179:}

gohao123 · 发表于 2012-12-7 20:00

还有几个小问题：
1。第一次或新打开--新单--存储时会覆盖前一单号
2。新单时AF8没可选择日期
3。C21点V时不保存服务技能“好” 21行点击也会出现“V”
4。AA21、AG21点击时会出现“V”本是不要的
5。数据NO没从1号开始
6。查询时没法修改！保护了

gohao123 · 发表于 2012-12-7 20:02

{:soso_e110:}不好意思！我是刚学的！（一点也还会的）

mineshine · 发表于 2012-12-10 09:50

gohao123 发表于 2012-12-7 20:00
还有几个小问题：
1。第一次或新打开--新单--存储时会覆盖前一单号
2。新单时AF8没可选择日期

1-5、"工程服務單" 代码修改如下
6、修改查询单：按"查询"查询服務单→按"查询修改"修改服务单

Private Sub CommandButton1_Click() '查询
Dim Sh As Worksheet, i As Long
Dim AB$, c As Object, fadd$, N
Application.ScreenUpdating = False
ClearCells '执行ClearCells清除栏位
Me.Unprotect '取消工作表保护
ComboBox1.Visible = True
Label1.Visible = False
Set Sh = Sheets("数据集")
With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
Set c = .Find(ComboBox1, LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox "找不到单号：" & [AB2], vbInformation + vbOKOnly
Else
[AB2] = c '单号
[B6] = c.Offset(, 1) '客户
[R6] = c.Offset(, 2) '地址
[AC6] = c.Offset(, 3) '连络人/连络方式
[C7] = c.Offset(, 4) '项目名称
[T7] = c.Offset(, 5) '机台编号
[C8] = Year(c.Offset(, 7)) '制造年
[F8] = Month(c.Offset(, 7)) '制造月
[I8] = Day(c.Offset(, 7)) '制造日
N = Split(c.Offset(, 8), " ~ ") '分割服务起止时间
[Q8] = Year(N(0)) '起年
[T8] = Month(N(0)) '起月
[W8] = Day(N(0)) '起日
[Y8] = Hour(N(0)) '起时
[AA8] = Minute(N(0)) '起分
[AD8] = Month(N(1)) '止月
[AF8] = Day(N(1)) '止日
[AH8] = Hour(N(1)) '止时
[AJ8] = Minute(N(1)) '止分
[E10] = c.Offset(, 11) '故障现象
[E13] = c.Offset(, 12) '处理过程
[E16] = c.Offset(, 13) '改善建议
[AC19] = c.Offset(, 15) '其它
[M20] = c.Offset(, 18) '其它補充
[AA21] = c.Offset(, 19) '客户签名
[AG21] = c.Offset(, 20) '服务人员
[AG22] = c.Offset(, 21) '服务时间
If c.Offset(, 6) = [AE7] Then '服务类别
[AD7] = "■"
Else
[AH7] = "■"
End If
If c.Offset(, 10) = [AD9] Then '备件使用
[AC9] = "■"
Else
[AH9] = "■"
End If
For i = 4 To 27
If i = 4 Or i = 8 Or i = 12 Or i = 16 Or i = 19 Or i = 22 Then
If c.Offset(, 9) = Cells(9, i) Then Cells(9, i - 1) = "■" '服务类型
ElseIf i = 5 Or i = 10 Or i = 16 Or i = 23 Or i = 27 Then
If c.Offset(, 14) = Cells(19, i) Then Cells(19, i - 1) = "■" '服务工作结果
End If
Next i
For i = 3 To 9 Step 2
If c.Offset(, 16) = Cells(20, i) Then Cells(21, i) = "ν" '服务技能
If c.Offset(, 17) = Cells(20, i) Then Cells(22, i) = "ν" '服务态度
Next i
End If
End With
Me.Protect '工作表保护
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click() '新单
Dim Sh As Worksheet
Dim AB$, c As Object, fadd$, NO
ComboBox1.Visible = False
Label1.Visible = True
ClearCells '执行ClearCells清除栏位
Set Sh = Sheets("数据集")
AB = "JC" & Format(Date, "yyyymmdd")
With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
Set c = .Find(AB, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
fadd = c.Address
Do
If Right(c, 5) > NO Then NO = Right(c, 5)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> fadd
Else
NO = ""
End If
End With
If NO = "" Then
Label1.Caption = "JC" & Format(Date, "yyyymmdd") & "00001" '新单编号
Else
Label1.Caption = AB & Format(NO + 1, "00000")
End If
Me.Unprotect '取消工作表保护
[AB2] = Label1.Caption 'AB2单号
CommandButton3.Enabled = True
End Sub
Private Sub CommandButton3_Click() '存储
Dim Sh As Worksheet, r As Long, dic As Object, i As Long
Dim D1, D2, ST$, SF$, SP4, SK$, SR$, SA$
If [Z19] = "■" And [AC19] = "" Then '服务工作结果：其他
MsgBox [Z20] & [A19] & "不可空白", vbInformation + vbOKCancel
[AC19].Select
Exit Sub
ElseIf [AC19] <> "" Then
[Z19] = "■"
For i = 4 To 22
If i = 4 Or i = 9 Or i = 15 Or i = 22 Then Cells(19, i) = "□"
Next i
End If
If [AG21] = "" Then
MsgBox [AG20] & "不可空白", vbInformation + vbOKCancel
[AG21].Select
Exit Sub
End If
If [AG22] = "" Then
MsgBox "AG22请填写服务时间", vbInformation + vbOKCancel
[AG22].Select
Exit Sub
End If
Set Sh = Sheets("数据集")
r = Sh.Cells(Sh.Rows.Count, 13).End(xlUp).Row + 1 '数据集M最后空白Row
If [AD7] = "■" Then '服务类别
ST = [AE7] '保固期
Else
ST = [AI7] '非保固期
End If
D1 = [C8] & "/" & [F8] & "/" & [I8] '制造日期
D2 = Format([Q8], "0000") & "/" & Format([T8], "00") & "/" & Format([W8], "00") & Space(1) & Format([Y8], "00") & ":" & Format([AA8], "00") & _
" ~ " & Format([Q8], "0000") & "/" & Format([AD8], "00") & "/" & Format([AF8], "00") & Space(1) & Format([AH8], "00") & ":" & Format([AJ8], "00") '服务起止时间
For i = 3 To 21 'C9~U9
If Cells(9, i) = "■" Then
SF = Cells(9, i + 1) '服务类型
Exit For
End If
Next i
If [AC9] = "■" Then '备件使用
SP = [AD9] '免费提供
Else
SP = [AI9] '收费提供
End If
For i = 4 To 26 'D19~Z19
If Cells(19, i) = "■" Then
SR = Cells(19, i + 1) '服务工作结果
Exit For
End If
Next i
For i = 3 To 9 Step 2 'C21~I21
If Cells(21, i) = "ν" Then
SK = Cells(20, i) '服务技能
Exit For
End If
Next i
For i = 3 To 9 Step 2 'C22~I22
If Cells(22, i) = "ν" Then
SA = Cells(20, i) '服务态度
Exit For
End If
Next i
With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
Set c = .Find(ComboBox1, LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
r = Sh.Cells(Sh.Rows.Count, 2).End(xlUp).Row + 1 '数据集最后空白Row
'NO,单号,客户,地址,连络人/连系方式,项目名称,机台编号,服务类别,制造日期,服务起止时间,服务类型,备件使用,故障现象,处理过程,改善建议,服务工作结果,其它,服务技能,服务态度,其它补充,客户签名,服务人员,服务时间
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])
Else
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])
End If
End With
a = MsgBox("存储已完成，是否要清除" & Me.Name & "内容？", vbInformation + vbYesNo)
If a = vbYes Then ClearCells '执行ClearCells清除栏位
CommandButton3.Enabled = False '隠藏"存储"按键
Label1.Visible = False '隠藏Label1
Set dic = CreateObject("scripting.dictionary")
For i = 5 To Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
If Not dic.exists(Sh.Cells(i, 2).Value & "") Then dic.Add Sh.Cells(i, 2).Value, "" '查找不重复单号
Next i
With ComboBox1
.Visible = True '显示ComboBox1
.List = dic.keys '将不重复单号写入ComboBox1组合清单
End With
Set dic = Nothing
Me.Protect '工作表保护
End Sub
Private Sub CommandButton4_Click() '打印
Label1.Visible = False '隠藏Lable1
ComboBox1.Visible = False '隠藏ComboBox1
Application.Dialogs(xlDialogPrinterSetup).Show
Me.PageSetup.PrintArea = Range("A1:AL24").Address '打印范围
With ActiveWindow.SelectedSheets
.PrintPreview 'Preview工程服务单预览列印
'.PrintOut Copies:=1 '打印，打印份数1
End With
ComboBox1.Visible = True '显示Combobox1
End Sub
Private Sub CommandButton5_Click() '查询修改
Dim Sh As Worksheet, r As Long, dic As Object, i As Long
Dim D1, D2, ST$, SF$, SP4, SK$, SR$, SA$
CommandButton3.Enabled = True '"存储"按键激活
Me.Unprotect '取消工作表保护
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng$, i%
If Me.ProtectContents = True Then
[C8,Q8,F8,T8,AD8,I8,W8,AF8,Y8,AH8,AA8,AJ8].Validation.Delete
Exit Sub '如果工作表视窗处于保护状态就不执行触发事件
Else
If CommandButton3.Enabled = True Then '当"存储"按键可用时
Rng = ""
If Target.Row = 8 Then '制造日期, 服务起止时间
If Target.Address = "$C$8:$D$8" Or Target.Address = "$Q$8:$R$8" Then
For i = Year(Date) To Year(Date) + 10 '年
Rng = Rng & "," & i
Next i
Rng = Mid(Rng, 2)
Target.Validation.Delete
Target.Validation.Add 3, 1, 1, Rng '数据有效性
ElseIf Target.Address = "$F$8:$G$8" Or Target.Address = "$T$8:$U$8" Or Target.Address = "$AD$8" Then
For i = 1 To 12 '月
Rng = Rng & "," & i
Next i
Rng = Mid(Rng, 2)
Target.Validation.Delete
Target.Validation.Add 3, 1, 1, Rng '数据有效性
ElseIf Target.Address = "$I$8" Or Target.Address = "$W$8" Or Target.Address = "$AF$8" Then
D = Day(DateSerial(Target.Offset(, -5), Target.Offset(, -2) + 1, 1) - 1)
For i = 1 To D '日
Rng = Rng & "," & i
Next i
Rng = Mid(Rng, 2)
Target.Validation.Delete
Target.Validation.Add 3, 1, 1, Rng '数据有效性
ElseIf Target.Address = "$Y$8" Or Target.Address = "$AH$8" Then
For i = 0 To 23 '时
Rng = Rng & "," & i
Next i
Rng = Mid(Rng, 2)
Target.Validation.Delete
Target.Validation.Add 3, 1, 1, Rng '数据有效性
ElseIf Target.Address = "$AA$8" Or Target.Address = "$AJ$8" Then
For i = 0 To 59 '分
Rng = Rng & "," & i
Next i
Rng = Mid(Rng, 2)
Target.Validation.Delete
Target.Validation.Add 3, 1, 1, Rng '数据有效性
End If
End If
If Target.Address = "$AD$7" Or Target.Address = "$AH$7" Then '服务类别
If [AD7] = "□" Then
[AD7] = "■" '保固期
[AH7] = "□" '非保固期
Else
[AD7] = "□" '保固期
[AH7] = "■" '非保固期
End If
End If
If Target.Address = "$AC$9" Or Target.Address = "$AH$9" Then '备件使用
If [AC9] = "□" Then
[AC9] = "■" '免费提供
[AH9] = "□" '收费提供
Else
[AC9] = "□" '免费提供
[AH9] = "■" '收费提供
End If
End If
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 '服务类型
If Target = "□" Then
Target = "■"
t = Target.Column
Else
Target = "□"
Exit Sub
End If
For i = 3 To 21 'C9,G9,K9,O9,,R9,U9
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) = "□"
Next i
End If
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 '服务工作结果
If Target = "□" Then
Target = "■"
t = Target.Column
Else
Target = "□"
Exit Sub
End If
If Target.Address <> "$Z$19" Then [AC19] = "" '选择非"其它",[AC19]清空
For i = 4 To 26 'D19,I19,O1,V19,,Z19
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) = "□"
Next i
End If
If (Target.Row = 21 Or Target.Row = 22) And (Target.Column > 2 And Target.Column < 10) Then '客户评价
If Cells(Target.Row, Target.Column) = "ν" Then
t = Target.Column
Else
Target = "ν"
t = Target.Column
End If
For i = 3 To 9 Step 2
If i <> t And Cells(Target.Row, i) = "ν" Then Cells(Target.Row, i) = ""
Next i
End If
Else
[C8,Q8,F8,T8,AD8,I8,W8,AF8,Y8,AH8,AA8,AJ8].Validation.Delete
End If
End If
End Sub
Sub ClearCells()
With Sheet1
.Unprotect
.Label1.Caption = "" '清除Label
.[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] = ""
.[E10:AK18,AC19:AK19,C21:I22,M20:Z22,AA21:AF22,AG21:AK21,AG22:AK22] = ""
.[AD7,AH7,C9,G9,K9,O9,R9,U9,AC9,AH9,D19,I19,O19,V19,Z19] = "□"
End With
End Sub

复制代码

gohao123 · 发表于 2012-12-10 10:21

保行数出错！现保存到行4了！因行3和行4有合并了！应从行5开始！！

mineshine · 发表于 2012-12-10 11:11

gohao123 发表于 2012-12-10 10:21
保行数出错！现保存到行4了！因行3和行4有合并了！应从行5开始！！

Private Sub CommandButton1_Click() '查询
Dim Sh As Worksheet, i As Long
Dim AB$, c As Object, fadd$, N
Application.ScreenUpdating = False
ClearCells '执行ClearCells清除栏位
Me.Unprotect '取消工作表保护
ComboBox1.Visible = True
Label1.Visible = False
Set Sh = Sheets("数据集")
With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
Set c = .Find(ComboBox1, LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
MsgBox "找不到单号：" & [AB2], vbInformation + vbOKOnly
Else
[AB2] = c '单号
[B6] = c.Offset(, 1) '客户
[R6] = c.Offset(, 2) '地址
[AC6] = c.Offset(, 3) '连络人/连络方式
[C7] = c.Offset(, 4) '项目名称
[T7] = c.Offset(, 5) '机台编号
[C8] = Year(c.Offset(, 7)) '制造年
[F8] = Month(c.Offset(, 7)) '制造月
[I8] = Day(c.Offset(, 7)) '制造日
N = Split(c.Offset(, 8), " ~ ") '分割服务起止时间
[Q8] = Year(N(0)) '起年
[T8] = Month(N(0)) '起月
[W8] = Day(N(0)) '起日
[Y8] = Hour(N(0)) '起时
[AA8] = Minute(N(0)) '起分
[AD8] = Month(N(1)) '止月
[AF8] = Day(N(1)) '止日
[AH8] = Hour(N(1)) '止时
[AJ8] = Minute(N(1)) '止分
[E10] = c.Offset(, 11) '故障现象
[E13] = c.Offset(, 12) '处理过程
[E16] = c.Offset(, 13) '改善建议
[AC19] = c.Offset(, 15) '其它
[M20] = c.Offset(, 18) '其它補充
[AA21] = c.Offset(, 19) '客户签名
[AG21] = c.Offset(, 20) '服务人员
[AG22] = c.Offset(, 21) '服务时间
If c.Offset(, 6) = [AE7] Then '服务类别
[AD7] = "■"
Else
[AH7] = "■"
End If
If c.Offset(, 10) = [AD9] Then '备件使用
[AC9] = "■"
Else
[AH9] = "■"
End If
For i = 4 To 27
If i = 4 Or i = 8 Or i = 12 Or i = 16 Or i = 19 Or i = 22 Then
If c.Offset(, 9) = Cells(9, i) Then Cells(9, i - 1) = "■" '服务类型
ElseIf i = 5 Or i = 10 Or i = 16 Or i = 23 Or i = 27 Then
If c.Offset(, 14) = Cells(19, i) Then Cells(19, i - 1) = "■" '服务工作结果
End If
Next i
For i = 3 To 9 Step 2
If c.Offset(, 16) = Cells(20, i) Then Cells(21, i) = "ν" '服务技能
If c.Offset(, 17) = Cells(20, i) Then Cells(22, i) = "ν" '服务态度
Next i
End If
End With
Me.Protect '工作表保护
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click() '新单
Dim Sh As Worksheet
Dim AB$, c As Object, fadd$, NO
ComboBox1.Visible = False
Label1.Visible = True
ClearCells '执行ClearCells清除栏位
Set Sh = Sheets("数据集")
AB = "JC" & Format(Date, "yyyymmdd")
With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
Set c = .Find(AB, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
fadd = c.Address
Do
If Right(c, 5) > NO Then NO = Right(c, 5)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> fadd
Else
NO = ""
End If
End With
If NO = "" Then
Label1.Caption = "JC" & Format(Date, "yyyymmdd") & "00001" '新单编号
Else
Label1.Caption = AB & Format(NO + 1, "00000")
End If
Me.Unprotect '取消工作表保护
[AB2] = Label1.Caption 'AB2单号
CommandButton3.Enabled = True
End Sub
Private Sub CommandButton3_Click() '存储
Dim Sh As Worksheet, r As Long, dic As Object, i As Long
Dim D1, D2, ST$, SF$, SP4, SK$, SR$, SA$
If [Z19] = "■" And [AC19] = "" Then '服务工作结果：其他
MsgBox [Z20] & [A19] & "不可空白", vbInformation + vbOKCancel
[AC19].Select
Exit Sub
ElseIf [AC19] <> "" Then
[Z19] = "■"
For i = 4 To 22
If i = 4 Or i = 9 Or i = 15 Or i = 22 Then Cells(19, i) = "□"
Next i
End If
If [AG21] = "" Then
MsgBox [AG20] & "不可空白", vbInformation + vbOKCancel
[AG21].Select
Exit Sub
End If
If [AG22] = "" Then
MsgBox "AG22请填写服务时间", vbInformation + vbOKCancel
[AG22].Select
Exit Sub
End If
Set Sh = Sheets("数据集")
r = Sh.Cells(Sh.Rows.Count, 13).End(xlUp).Row + 1 '数据集M最后空白Row
If [AD7] = "■" Then '服务类别
ST = [AE7] '保固期
Else
ST = [AI7] '非保固期
End If
D1 = [C8] & "/" & [F8] & "/" & [I8] '制造日期
D2 = Format([Q8], "0000") & "/" & Format([T8], "00") & "/" & Format([W8], "00") & Space(1) & Format([Y8], "00") & ":" & Format([AA8], "00") & _
" ~ " & Format([Q8], "0000") & "/" & Format([AD8], "00") & "/" & Format([AF8], "00") & Space(1) & Format([AH8], "00") & ":" & Format([AJ8], "00") '服务起止时间
For i = 3 To 21 'C9~U9
If Cells(9, i) = "■" Then
SF = Cells(9, i + 1) '服务类型
Exit For
End If
Next i
If [AC9] = "■" Then '备件使用
SP = [AD9] '免费提供
Else
SP = [AI9] '收费提供
End If
For i = 4 To 26 'D19~Z19
If Cells(19, i) = "■" Then
SR = Cells(19, i + 1) '服务工作结果
Exit For
End If
Next i
For i = 3 To 9 Step 2 'C21~I21
If Cells(21, i) = "ν" Then
SK = Cells(20, i) '服务技能
Exit For
End If
Next i
For i = 3 To 9 Step 2 'C22~I22
If Cells(22, i) = "ν" Then
SA = Cells(20, i) '服务态度
Exit For
End If
Next i
With Sh.Range("B3:B" & Sh.Cells(Sh.Rows.Count, 13).End(xlUp).Row)
Set c = .Find(ComboBox1, LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
r = Sh.Cells(Sh.Rows.Count, 13).End(xlUp).Row + 1 '数据集最后空白Row
'NO,单号,客户,地址,连络人/连系方式,项目名称,机台编号,服务类别,制造日期,服务起止时间,服务类型,备件使用,故障现象,处理过程,改善建议,服务工作结果,其它,服务技能,服务态度,其它补充,客户签名,服务人员,服务时间
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])
Else
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])
End If
End With
a = MsgBox("存储已完成，是否要清除" & Me.Name & "内容？", vbInformation + vbYesNo)
If a = vbYes Then ClearCells '执行ClearCells清除栏位
CommandButton3.Enabled = False '隠藏"存储"按键
Label1.Visible = False '隠藏Label1
Set dic = CreateObject("scripting.dictionary")
For i = 5 To Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
If Not dic.exists(Sh.Cells(i, 2).Value & "") Then dic.Add Sh.Cells(i, 2).Value, "" '查找不重复单号
Next i
With ComboBox1
.Visible = True '显示ComboBox1
.List = dic.keys '将不重复单号写入ComboBox1组合清单
End With
Set dic = Nothing
Me.Protect '工作表保护
End Sub
Private Sub CommandButton4_Click() '打印
Label1.Visible = False '隠藏Lable1
ComboBox1.Visible = False '隠藏ComboBox1
Application.Dialogs(xlDialogPrinterSetup).Show
Me.PageSetup.PrintArea = Range("A1:AL24").Address '打印范围
With ActiveWindow.SelectedSheets
.PrintPreview 'Preview工程服务单预览列印
'.PrintOut Copies:=1 '打印，打印份数1
End With
ComboBox1.Visible = True '显示Combobox1
End Sub
Private Sub CommandButton5_Click() '查询修改
Dim Sh As Worksheet, r As Long, dic As Object, i As Long
Dim D1, D2, ST$, SF$, SP4, SK$, SR$, SA$
CommandButton3.Enabled = True '"存储"按键激活
Me.Unprotect '取消工作表保护
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng$, i%
If Me.ProtectContents = True Then
[C8,Q8,F8,T8,AD8,I8,W8,AF8,Y8,AH8,AA8,AJ8].Validation.Delete
Exit Sub '如果工作表视窗处于保护状态就不执行触发事件
Else
If CommandButton3.Enabled = True Then '当"存储"按键可用时
Rng = ""
If Target.Row = 8 Then '制造日期, 服务起止时间
If Target.Address = "$C$8:$D$8" Or Target.Address = "$Q$8:$R$8" Then
For i = Year(Date) To Year(Date) + 10 '年
Rng = Rng & "," & i
Next i
Rng = Mid(Rng, 2)
Target.Validation.Delete
Target.Validation.Add 3, 1, 1, Rng '数据有效性
ElseIf Target.Address = "$F$8:$G$8" Or Target.Address = "$T$8:$U$8" Or Target.Address = "$AD$8" Then
For i = 1 To 12 '月
Rng = Rng & "," & i
Next i
Rng = Mid(Rng, 2)
Target.Validation.Delete
Target.Validation.Add 3, 1, 1, Rng '数据有效性
ElseIf Target.Address = "$I$8" Or Target.Address = "$W$8" Or Target.Address = "$AF$8" Then
D = Day(DateSerial(Target.Offset(, -5), Target.Offset(, -2) + 1, 1) - 1)
For i = 1 To D '日
Rng = Rng & "," & i
Next i
Rng = Mid(Rng, 2)
Target.Validation.Delete
Target.Validation.Add 3, 1, 1, Rng '数据有效性
ElseIf Target.Address = "$Y$8" Or Target.Address = "$AH$8" Then
For i = 0 To 23 '时
Rng = Rng & "," & i
Next i
Rng = Mid(Rng, 2)
Target.Validation.Delete
Target.Validation.Add 3, 1, 1, Rng '数据有效性
ElseIf Target.Address = "$AA$8" Or Target.Address = "$AJ$8" Then
For i = 0 To 59 '分
Rng = Rng & "," & i
Next i
Rng = Mid(Rng, 2)
Target.Validation.Delete
Target.Validation.Add 3, 1, 1, Rng '数据有效性
End If
End If
If Target.Address = "$AD$7" Or Target.Address = "$AH$7" Then '服务类别
If [AD7] = "□" Then
[AD7] = "■" '保固期
[AH7] = "□" '非保固期
Else
[AD7] = "□" '保固期
[AH7] = "■" '非保固期
End If
End If
If Target.Address = "$AC$9" Or Target.Address = "$AH$9" Then '备件使用
If [AC9] = "□" Then
[AC9] = "■" '免费提供
[AH9] = "□" '收费提供
Else
[AC9] = "□" '免费提供
[AH9] = "■" '收费提供
End If
End If
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 '服务类型
If Target = "□" Then
Target = "■"
t = Target.Column
Else
Target = "□"
Exit Sub
End If
For i = 3 To 21 'C9,G9,K9,O9,,R9,U9
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) = "□"
Next i
End If
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 '服务工作结果
If Target = "□" Then
Target = "■"
t = Target.Column
Else
Target = "□"
Exit Sub
End If
If Target.Address <> "$Z$19" Then [AC19] = "" '选择非"其它",[AC19]清空
For i = 4 To 26 'D19,I19,O1,V19,,Z19
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) = "□"
Next i
End If
If (Target.Row = 21 Or Target.Row = 22) And (Target.Column > 2 And Target.Column < 10) Then '客户评价
If Cells(Target.Row, Target.Column) = "ν" Then
t = Target.Column
Else
Target = "ν"
t = Target.Column
End If
For i = 3 To 9 Step 2
If i <> t And Cells(Target.Row, i) = "ν" Then Cells(Target.Row, i) = ""
Next i
End If
Else
[C8,Q8,F8,T8,AD8,I8,W8,AF8,Y8,AH8,AA8,AJ8].Validation.Delete
End If
End If
End Sub
Sub ClearCells()
With Sheet1
.Unprotect
.Label1.Caption = "" '清除Label
.[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] = ""
.[E10:AK18,AC19:AK19,C21:I22,M20:Z22,AA21:AF22,AG21:AK21,AG22:AK22] = ""
.[AD7,AH7,C9,G9,K9,O9,R9,U9,AC9,AH9,D19,I19,O19,V19,Z19] = "□"
End With
End Sub

复制代码

gohao123 · 发表于 2012-12-10 13:43

又要修改动了！附件中！

gohao123 · 发表于 2012-12-14 18:52

没人理我了哦

gohao123 · 发表于 2012-12-18 22:09

再更新了一下！烦各高手帮处理一下！谢谢！！

用户名		自动登录	找回密码
密码			免费注册

[求助] 怎样做保存/打印/查询功能

浏览过的版块