工作表随日期动态隐藏或显示

gunghhtt

求代码、A2单元格显示是多少  01-31工作表就只显示相应的工作表，别的隐藏
比如今天是28号，工作表01-31中，只显示“28“工作表

maditate

把此过程放在 ThisWorkbook 模块中，打开文件自动执行。

Private Sub Workbook_Open()
日期 = Day(Now)
If Len(日期) < 2 Then
  当日 = "0" & 日期
Else
当日 = CStr(日期)
End If
aa = Array("分类", "汇总", 当日)
For Each myshe In ThisWorkbook.Sheets
   rr = Application.Match(myshe.Name, Application.Index(aa, , 0), 0)
  If IsNumeric(rr) = False Then
    Sheets(myshe.Name).Visible = 2
  Else
    Sheets(myshe.Name).Visible = -1
  End If
Next myshe
End Sub

[ 本帖最后由 maditate 于 2008-12-28 16:59 编辑 ]

daley

简化代码:
Sub 冲天复制工作表31并改名()
    Dim Password, Pword As String
    Password = "745127"
    Pword = InputBox("Please input Your Password!" + (Chr(13)) + (Chr(13)) + "请输入您的密码！", "用户权限确认", "*****")
    If Pword <> Password Then
    m = MsgBox("Sorry! Your Password is error!" + (Chr(13)) + (Chr(13)) + "对不起!您的密码不对！" + (Chr(13)) + (Chr(13)) + "有问题请联络作者13575900163，谢谢支持！", vbExclamation, "提示信息")
    Exit Sub
    End If
    '
    Sheets("01").Copy Before:=Sheets(2)
    Dim x As Integer
    For x = 2 To 30
    Sheets("01 ( " & x & ")").Copy Before:=Sheets(x + 1)
   
    Sheets("01 (" & x & ")").Activate
    Sheets("01 (" & x & ")").Name = "0" & x
    Next
End Sub

daley

Private Sub Worksheet_Activate()
   
    With Application
    .CutCopyMode = True '削减复制模式
    .OnKey "^c" '使用快捷复制键
    .OnKey "^v" '使用快捷粘贴键
    .OnKey "^x"  '使用快捷剪切键
    .CellDragAndDrop = True  '使用拖放功能
    .CommandBars("Cell").Enabled = True '单元格使用右键
    .CommandBars.DisableAskAQuestionDropdown = False ' 使用“键入需要帮助的问题”
    .CommandBars("Toolbar List").Enabled = True '使用工作表菜单栏和其它工具栏上的右击键
    .CommandBars.DisableCustomize = False '使用“自定义”对话框
    .CommandBars("Worksheet Menu Bar").Enabled = True '使用菜单栏“最上面一行”
    .CommandBars("ply").Enabled = True '使用工作表标签栏右键
    .CommandBars("Standard").Enabled = True '使用标准工具栏
    End With
End Sub

daley

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
   
    Dim x As Worksheet
    For Each x In Worksheets
    If x.Name <> "汇总" And x.Name <> Format(Date, "dd") Then
    x.Visible = 0
    Else
    x.Visible = -1
    End If
    Next
    Application.ScreenUpdating = True
End Sub

gunghhtt

太厉害了，都是高手啊，我就是录制的宏。

好学excel

太好了，学习了