工作表目录

追梦不停的人 · 发表于 2012-8-6 11:40

请问，谁能帮我做个工作表目录，大概要求：在第一张总表（此工作表内只有每个分表的名称没有其他内容）里面搞几个链接可以打开每个分表（每个分表里面都有个“返回目录”的链接或按钮），打开一个分表后其他多余的工作表全都隐藏起来，单机“返回目录”后又能回到总表？万分感谢！（鲜花我不会吝啬的）

Desertsea · 发表于 2012-8-6 12:07

应该不难，可能费时间。“返回目录”的按钮建议做成工具栏，可以减少代码，启动隐藏用与表名为"a"的表实现，表格名大于A的隐藏。

追梦不停的人 · 发表于 2012-8-6 12:22

Desertsea 发表于 2012-8-6 12:07
应该不难，可能费时间。“返回目录”的按钮建议做成工具栏，可以减少代码，启动隐藏用与表名为"a"的表实现， ...

能否来个附件？谢谢！

追梦不停的人 · 发表于 2012-8-6 12:46

难道没有人帮我妈？伤心欲绝ing{:soso__12048363619712456244_1:}

天堑小舟 · 发表于 2012-8-6 12:58

有点象V初课时1的作业样.

Desertsea · 发表于 2012-8-6 13:04

本帖最后由 Desertsea 于 2012-8-6 13:04 编辑

替你做了一个，不知道是否符合你的口味，当非主页工作表激活时显示工作栏。
在主页，双击单元格进入。

文件索引.rar (19.06 KB, 下载次数: 176)

Option Explicit
Public Const ws_psw As String = "123"
Sub 打开报表()
Application.ScreenUpdating = False
If Sheets("首页").[A1] = "3 1" Then
ActiveWorkbook.Unprotect Password:=ws_psw
Sheets("sheet2").Visible = True And Sheets("sheet2").Activate
ElseIf Sheets("首页").[A1] = "4 1" Then
ActiveWorkbook.Unprotect Password:=ws_psw
Sheets("sheet3").Visible = True And Sheets("sheet3").Activate
ElseIf Sheets("首页").[A1] = "5 1" Then
ActiveWorkbook.Unprotect Password:=ws_psw
Sheets("sheet4").Visible = True And Sheets("sheet4").Activate
ElseIf Sheets("首页").[A1] = "6 1" Then
ActiveWorkbook.Unprotect Password:=ws_psw
Sheets("sheet5").Visible = True And Sheets("sheet5").Activate
End If
Application.ScreenUpdating = False
End Sub
Sub 建立索引()
Sheets("首页").Cells(3, 1).Value = Sheet2.Name
Sheets("首页").Cells(4, 1).Value = Sheet3.Name
Sheets("首页").Cells(5, 1).Value = Sheet4.Name
Sheets("首页").Cells(6, 1).Value = Sheet5.Name
End Sub
Sub 工具栏加载()
Application.ScreenUpdating = False '关闭屏幕刷新
Dim arr As Variant
Dim id As Variant
Dim i As Integer
Dim Toolbar As CommandBar
On Error Resume Next
Application.CommandBars("MyToolbar").Delete
arr = Array("返回主页")
id = Array(1017)
Set Toolbar = Application.CommandBars.Add("MyToolbar", msoBarTop, , True)
With Toolbar
.Protection = msoBarNoResize
.Visible = True
For i = 0 To 8
With .Controls.Add(Type:=msoControlButton)
.Caption = arr(i)
.FaceId = id(i)
.OnAction = arr(i)
.Style = msoButtonIconAndCaptionBelow
End With
Next
End With
Set Toolbar = Nothing
Application.ScreenUpdating = True '关闭屏幕刷新
End Sub
Sub 系统卸载()
Dim j As Integer
On Error Resume Next
Application.ScreenUpdating = False '关闭屏幕刷新
ActiveWorkbook.Unprotect Password:=ws_psw
Sheets("A").Visible = True
Sheets("A").Activate
For j = 1 To Sheets.Count '隐藏所有工作表
If Sheets(j).Name <> "A" Then Sheets(j).Visible = False
Next j
ActiveWorkbook.Protect Password:=ws_psw
Application.ScreenUpdating = True '关闭屏幕刷新
End Sub
Sub 返回主页()
ActiveWorkbook.Unprotect Password:=ws_psw
Application.CommandBars("MyToolbar").Delete
ActiveSheet.Visible = False
Sheets("首页").Activate
ActiveWorkbook.Protect Password:=ws_psw
End Sub
Sub 系统加载()
On Error Resume Next '防错
Application.ScreenUpdating = False '关闭屏幕刷新
ActiveWorkbook.Unprotect Password:=ws_psw
With Application
.AutoRecover.Enabled = False
.Caption = "123" '更改应用程序名
Worksheets("首页").Visible = True
Worksheets("A").Visible = False
Worksheets("首页").Select
Application.ScreenUpdating = True
End With
End Sub

复制代码

Desertsea · 发表于 2012-8-6 13:05

追梦不停的人发表于 2012-8-6 12:46
难道没有人帮我妈？伤心欲绝ing

帮你也要时间的，哥

追梦不停的人 · 发表于 2012-8-6 13:24

天堑小舟发表于 2012-8-6 12:58
有点象V初课时1的作业样.

您能帮我解决吗？万分感谢！！！！！！！！！！！！！！！！！！！！！！！

追梦不停的人 · 发表于 2012-8-6 13:33

Desertsea 发表于 2012-8-6 13:05
帮你也要时间的，哥

打扰到您的正常工作真不好意思，但是还是问一下为什么一定要双击才行？还有为什么分表没有“返回目录”？谢谢！

Desertsea · 发表于 2012-8-6 21:46

1.可以用复选框，但是双击单元格的方式最方便
2.分表会弹出工具栏，工具栏上有返回主页功能，能减少重复代码。

		自动登录	找回密码
密码			免费注册

[求助] 工作表目录