工作月历(工作管理EXCEL程序)

shen542

谢谢楼主，不错！

zzzz2006

谢谢分享，下来看看

qig14

楼主，只有9个附件，但是解压的时候是提士缺少10.rar的。。。怎么回事，

heylipotato

WHY I STILL COUNDNT OPEN THOSE FILE EVEN I RENAME ALL OF THEM 。。REALLY HOPE I COULD SEE THESE FILE

SBXAGU

谢谢分享，辛苦了。不过有没有更新版呢

littinbin

不能解压。不知道怎么会有人回复说不错

pbh_2010

谁能在上传一份？现在下载不好用了

枫桥夜泊lwb

下载改了分卷序号不能解压

一指禅

谢谢楼主分享！
工作月历(工作管理EXCEL程序)
修改一点小BUG

一指禅

修改后代码：
Sub auto_open()
  Application.ScreenUpdating = False
  On Error Resume Next
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    a = Format(Now, "yymm")
    If ActiveSheet.Name = a Then
        Exit Sub
    End If
    Sheets(a).Select
End Sub
Sub ModiName()
  Application.ScreenUpdating = False
  On Error Resume Next
  Dim a$, b1$, b2$, i%
    If Right(Sheets(1).Name, 2) <> "01" Or Right(Sheets(12).Name, 2) <> "12" Then
        MsgBox "应将1~12月份报表放在本工作簿文件的前列"
        Exit Sub
    End If
    a = Right(Sheets("操作说明").Range("C5"), 2)
    For i = 1 To 12
        If i < 9 Then
            b1 = 0 & i + 1
         Else
            b1 = i + 1
        End If
        If i < 11 Then
            b2 = 0 & i - 1
        Else
            b2 = i - 1
        End If
        
        Sheets(i).Select
        Sheets(i).Name = a & Right(Sheets(i).Name, 2)
        ActiveSheet.Unprotect
        If i < 12 Then
            Range("E5").Hyperlinks(1).SubAddress = "'" & a & b1 & "'!_MONTHLY"
        End If
        If i > 1 Then
            ActiveSheet.Shapes("Rectangle 5").Select
            Selection.ShapeRange.Item(1).Hyperlink.SubAddress = "'" & a & b2 & "'!_MONTHLY"
        End If
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True
    Next i
    Sheets(1).Select
End Sub