|
- Private Sub Workbook_Open()
- Dim nf$, yf$, dd, i&, rq$
- Sheet1.Activate
- Rows(6).Resize(31).Interior.ColorIndex = xlNone
- [a6].Resize(31, 1).ClearContents
- nf = Year(Date): yf = Month(Date)
- [a1] = " " & nf & "年" & yf & "月Y部品发注"
- dd = Day(DateSerial(nf, yf + 1, 0))
- [a6] = DateSerial(nf, yf, 1)
- [a6].AutoFill [a6].Resize(dd, 1)
- rq = nf & Format(yf, "00")
- Call lqxs(rq)
- End Sub
- Sub lqxs(rq)
- Dim myPath$, myName$, Arr1, i&, x$, m&, d
- Set d = CreateObject("Scripting.Dictionary")
- myPath = ThisWorkbook.Path & ""
- myName = "工作日历.xlsx"
- With GetObject(myPath & myName)
- Arr1 = .Sheets(1).Range("A1").CurrentRegion
- For i = 2 To UBound(Arr1)
- x = Arr1(i, 2) & ""
- If Not d.exists(x) Then d(x) = i
- Next
- .Close False
- End With
- If d.exists(rq) Then
- m = d(rq)
- For i = 6 To Arr1(m, 5) + 5
- If Arr1(m + 1, i) = 0 Then Cells(i, 1).Resize(1, 47).Interior.ColorIndex = 44
- Next
- End If
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|