[已解决]自动到期提醒

qian123

管理人员名册.rar (22.69 KB, 下载次数: 116)

2012-10-5 12:40 上传

点击文件名下载附件

求解！合同还有15天到期自动提醒！！每次打开excel自动跳出提示框!!谢谢

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-10-5 13:59

1. Private Sub Workbook_Open()
   
2.     Dim arrName, arrDate
   
3.     Dim iRow As Long, i As Long
   
4.     Dim sName As String
   
5.     Dim dDate As Date
   
6.    
   
7.     iRow = [a2].End(xlDown).Row
   
8.     If Cells(iRow, 1) = "" Then Exit Sub
   
9.     arrName = Range("h2:h" & iRow).Value
   
10.     arrDate = Range("w2:w" & iRow).Value
    
11.     For i = 1 To UBound(arrName)
    
12.         dDate = arrDate(i, 1)
    
13.         If Date < dDate And dDate - Date <= 15 Then
    
14.             sName = IIf(sName = "", arrName(i, 1) & "   " & arrDate(i, 1), sName & vbCr & arrName(i, 1) & "   " & arrDate(i, 1))
    
15.         Else
    
16.             If Date > dDate Then sName = IIf(sName = "", arrName(i, 1) & "   " & arrDate(i, 1), sName & vbCr & arrName(i, 1) & "   " & arrDate(i, 1))
    
17.         End If
    
18.     Next
    
19. 
    
20.     If Len(sName) > 0 Then
    
21.         MsgBox "合同马上到期人员名单:" & vbCr & sName
    
22.     End If
    
23.    
    
24. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

可以在合同到期日那一列加条件格式嘛，快到期的红色背景

qian123

hwc2ycy 发表于 2012-10-5 13:06
可以在合同到期日那一列加条件格式嘛，快到期的红色背景

格式还要自己去找！ 我要让自己跳出个提标框！方便一点

hwc2ycy

1. Private Sub Workbook_Open()
   
2.     Dim arrName, arrDate
   
3.     Dim iRow As Long, i As Long
   
4.     Dim sName As String
   
5.     Dim dDate As Date
   
6.    
   
7.     iRow = [a2].End(xlDown).Row
   
8.     If Cells(iRow, 1) = "" Then Exit Sub
   
9.     arrName = Range("h2:h" & iRow).Value
   
10.     arrDate = Range("w2:w" & iRow).Value
    
11.     For i = 1 To UBound(arrName)
    
12.         dDate = arrDate(i, 1)
    
13.         If Date < dDate And dDate - Date <= 15 Then
    
14.             sName = IIf(sName = "", arrName(i, 1), sName & vbCr & arrName(i, 1))
    
15.         End If
    
16.     Next
    
17. 
    
18.     If Len(sName) > 0 Then
    
19.         MsgBox "合同马上到期人员名单:" & vbCr & sName
    
20.     End If
    
21.    
    
22. End Sub

复制代码

hwc2ycy

1. Private Sub Workbook_Open()
   
2.     Dim arrName, arrDate
   
3.     Dim iRow As Long, i As Long
   
4.     Dim sName As String
   
5.     Dim dDate As Date
   
6.    
   
7.     iRow = [a2].End(xlDown).Row
   
8.     If Cells(iRow, 1) = "" Then Exit Sub
   
9.     arrName = Range("h2:h" & iRow).Value
   
10.     arrDate = Range("w2:w" & iRow).Value
    
11.     For i = 1 To UBound(arrName)
    
12.         dDate = arrDate(i, 1)
    
13.         If Date < dDate And dDate - Date <= 15 Then
    
14.             sName = IIf(sName = "", arrName(i, 1) & "   " & arrDate(i, 1), sName & vbCr & arrName(i, 1) & "   " & arrDate(i, 1))
    
15.         End If
    
16.     Next
    
17. 
    
18.     If Len(sName) > 0 Then
    
19.         MsgBox "合同马上到期人员名单:" & vbCr & sName
    
20.     End If
    
21.    
    
22. End Sub
    

复制代码

hwc2ycy

一定要启用宏才行。

hwc2ycy

管理人员名单【到期】.rar (69.57 KB, 下载次数: 106)

2012-10-5 13:44 上传

点击文件名下载附件

qian123

hwc2ycy 发表于 2012-10-5 13:41
一定要启用宏才行。

不能打开excel自动运行么？ 还有2011年的怎么不行？

hwc2ycy

你的要求是“合同还有15天到期自动提醒”
现在2012年了耶，

qian123

hwc2ycy 发表于 2012-10-5 13:46
你的要求是“合同还有15天到期自动提醒”
现在2012年了耶，

把还有15天将过期跟已过期都提示出来~！！要怎么弄！！谢谢了{:011:}