Private Sub CheckDate_Click()
Dim cd
cd = YQCheckDate()
End Sub
Public Function YQCheckDate()
Dim i As Integer, r As Integer, num As Integer
Dim T1, T2, T3 As Date
Dim lie As Integer
lie = 15 '列号15 即 O 列
num = 0 '统计次校日期到期数量
r = Range("o65536").End(xlUp).Row '统计o列有数据的单元格个数有多少
T2 = Now() '当前日期
'T1 = VBA.DateSerial(2022, 6, 26)'日期转换
'T1 = Range("A1").Value'获取单元格的值
'循环单元格数据
For i = 1 To r
T1 = Cells(i, lie)
If (IsEmpty(T1)) Then
Cells(i, lie).Interior.Pattern = xlNone '清除背景色
Else
If (IsDate(T1)) Then
T3 = T1 - 30 '次校日期往前30天
If (T2 > T3) Then
'MsgBox ("仪器校验日期过期了")
Cells(i, lie).Interior.Color = 255 '填充红色
num = num + 1
Else
Cells(i, lie).Interior.Pattern = xlNone '清除背景色
End If
End If
End If
Next
If (num > 0) Then
Dim result
result = MsgBox("总共有" + Str(num) + "个设备到期,需安排校正!", vbExclamation)
End If
End Function
excel 函数公式 : 返回由文本字符串指定的引用
=INDIRECT(“k_”&REPLACE(N6,5,1,“_”))
Private Sub CommandButton1_Click()
'updateby Extendoffice
Dim xCount As Variant
Dim xScreen As Boolean
Dim I As Long
Dim S As Long
On Error Resume Next
LInput:
xCount = Application.InputBox("请输入要求打印的份数:", "自动生产序列号")
If TypeName(xCount) = "Boolean" Then Exit Sub
If (xCount = "") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then
MsgBox "输入错误,请重新输入", vbInformation, "自动生产序列号"
GoTo LInput
Else
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
Application.Dialogs(xlDialogPrinterSetup).Show
For I = 1 To xCount
'ActiveSheet.Range("A1").Value = " Company-00" & I
'ActiveSheet.Range("K6").Value = I
'S = Len(ActiveSheet.Range("K6").Value)
S = Len(Str(I))
Select Case S
Case 2
ActiveSheet.Range("C5").Value = ActiveSheet.Range("K5").Value & "000" & I
Case 3
ActiveSheet.Range("C5").Value = ActiveSheet.Range("K5").Value & "00" & I
Case 4
ActiveSheet.Range("C5").Value = ActiveSheet.Range("K5").Value & "0" & I
Case Else
ActiveSheet.Range("C5").Value = ActiveSheet.Range("K5").Value & I
End Select
ActiveSheet.PrintOut
'Application.Dialogs(xlDialogPrinterSetup).Show
'ActiveSheet.PrintPreview
Next
ActiveSheet.Range("C5").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub