领导值班（宏）

413191246se

1. Sub 领导值班()
   
2.     Dim x$, y$, a&, b$, c&, d&, i&, p$, q$
   
3.     x = InputBox("", "起始日期 - 2020/7/17", "2020/7/17")
   
4.     If x = "" Then End
   
5.     y = InputBox("", "截止日期 - 2020/8/25", "2020/8/25")
   
6.     If y = "" Then End
   
7.     a = DateDiff("d", x, y) + 1
   
8.     b = InputBox("", "领导人数", "3")
   
9.     If b = "" Then End
   
10.     If Not (b Like "[1-9]" Or b Like "[1-9][0-9]") Then End
    
11.     ReDim arr(0 To b - 1)
    
12.     c = Int(a / b)
    
13.     d = a - b * c
    
14.     For i = 1 To b
    
15.         arr(i - 1) = c
    
16.     Next
    
17.     For i = 1 To d
    
18.         arr(i - 1) = c + 1
    
19.     Next
    
20.     Documents.Add
    
21.     With Selection
    
22.         .TypeText Text:="共值班" & a & "天！" & vbCr
    
23.         For i = 1 To b
    
24.             If i = 1 Then p = x Else p = DateAdd("d", 1, q)
    
25.             q = DateAdd("d", arr(i - 1) - 1, p)
    
26.             .TypeText Text:=i & "号领导(" & arr(i - 1) & "天) " & p & "—" & q & vbCr
    
27.         Next
    
28.     End With
    
29.     With ActiveDocument.Content.Find
    
30.         .Execute "([0-9]{4})/([0-9]{1,2})/([0-9]{1,2})", , , 1, , , , , , "\1年\2月\3日", 2
    
31.         If MsgBox("是否删除年份？", 4 + 16) = vbYes Then .Execute "[0-9]{4}年", , , 1, , , , , , "", 2
    
32.     End With
    
33. End Sub

复制代码