整了快一天，通过百度的学习了解和自己琢磨测试，总算第一次偿试着弄出了一段EXCEL宏代码的写法。以下宏代码的作用情况是针对用户类似需求时用：
在EXCEL文档中建有很多的工作表页（比如工作表页有100页），其中有一页为总表页（比如以目录形式展现），平时工作时，希望除总表页显示外，其他表页都隐藏起来，但在要进入相应的表页工作时，直接在总表页中选择项应的子页项，以链接的方式进入，由于常规的普通操作下，如果子表页被隐藏起来后，直接想通过链接的方式进入时，会发现EXCEL提示出错，无法正常进入想要的工作表内，这种情况下如果想实际希望的效果，需要通过宏代码的处理来实现，现在把本人琢磨出来的宏代码贴出来，供大家参考用。
在总表页中的宏代码如下：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row < 6 And Target.Column = 1 Then '判断要触发宏操作的单元格区域
Call OpenMySheet '调用宏函数操作
End If
End Sub
Sub OpenMySheet()
Dim x
x = ActiveCell.Value '获取被选中单元格中的内容（本处与工作表名称对应，工作表名以变量方式定义）
Sheets(x).Visible = True '先让目标工作表取消隐藏
Sheets(x).Select '选中目标工作表（即可进行操作业务）
End Sub
在其他所有的子工作表中，插入相同的宏代码，如下：
Private Sub Worksheet_Deactivate()
Sheet2.Select '选择目标工作表（即本处的汇总表/第2页）
Sheet50.Visible = False '将当前的工作表隐藏起来（即本处的第50页）
End Sub
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
对上述子工作表的宏代码做进一步简化和优化后，如下（第一次修改调整后的情况）：
Dim sht '定义全局变量，用于获取子表页的工作表名称
Private Sub Worksheet_Activate()
If Range("a1").Value = "请录入编码" Or Range("a1").Value = "" Then
MsgBox "当前物料缺少编码，请即时设定录入编码！"
End If
If Range("a1").Value <> "请录入编码" And Range("a1").Value <> "" Then
ActiveSheet.Name = ActiveSheet.Range("a1").Value
End If
sht = ActiveSheet.Name '获取当前子表页的工作表名称，以做为后面退出时隐藏调用
End Sub
Private Sub Worksheet_Deactivate()
'MsgBox sht '测试语句
Sheet2.Select '选择目标工作表（即本处的汇总表/第2页）
If sht <> "样表" Then
Sheets(sht).Visible = False '将当前的工作表隐藏起来（即本处的第50页/已用变量取代）
End If
End Sub
*************************************************************************
///////////////////////////////////////////////////////////////////////////////////////////
经过对以上功能的宏代码重新进一步优化调整后，重新建立的宏代码如下（第二次全面修改调整，以下代码均测试有效）（上图为本次调整后对应的代码截图情况）：
在总表页中（即工作表目录）的宏代码如下：
--------------------------------------------------------
Dim m1 As String, m2 As String, sName As Worksheet, n '定义三个全局变量，注意变量m1,m2的类型为字符型，否则后面可能会出错
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) '双击单元格触发宏操作（进入子工作表页）
n = ""
m1 = ""
If Target.Row > 2 And Target.Row < 500 And Target.Column = 1 Then '判断要触发宏操作的单元格区域
n = ActiveCell.Address '获取双击单元格的地址，以便提取内容
m1 = Trim(Range(n).Value) '获取双击单元格内的内容，以做为后面提取单元格的内容使用
Call OpenMySheet '调用宏函数操作
End If
End Sub
Sub OpenMySheet() '定义双击单元格时的操作函数
Set sName = Nothing '先清空变量的值（m1,m2,n的相关操作作用相同）
If m1 <> "" Then '先判断单元格的内容是否为空，如不为空再继续后面的操作
'MsgBox "内容" & m1 '测试语句
On Error Resume Next
Set sName = Sheets(m1) '判断以双击单元格内容为名称的工作表是否存在，并进行相应的后续操作
If sName Is Nothing Then
MsgBox "指定的工作表不存在，请检查名称是否正确或增加相应名称的表页！"
Else
Sheets(m1).Visible = True '先让目标工作表取消隐藏
Sheets(m1).Select '选中目标工作表（即可进行操作业务）
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '单元格被选中时触发宏操作（本处主要配合工作表改名获取参数值用）
n = ""
m1 = ""
n = ActiveCell.Address
m1 = Trim(Range(n).Value) '此时获得的单元格内容为工作表改名前的名称
End Sub
Private Sub Worksheet_Change(ByVal Target As Range) '单元格内容发生改动时触发宏操作（修改工作表名称）
If Target.Row > 2 And Target.Row < 500 And Target.Column = 1 Then '判断要触发宏操作的单元格区域
Call RnameMySheet '调用宏函数操作
End If
End Sub
Sub RnameMySheet()
m2 = ""
m2 = Trim(Range(n).Value) '获取被选中单元格中的内容（本处与工作表名称对应，此处得到的是更改后的单元格内容）
'MsgBox "改名前-" & m1 & "-改名后" & m2 '测试语句
On Error Resume Next
Set sName = Sheets(m1)
If m2 = "" And m1 <> "" Then
MsgBox "更改后的内容不能为空，否则将失去与工作表的联系！"
Range(n).Value = m1
End If
If m1 <> "" And m2 <> "" And m1 <> m2 And sName Is Nothing = False Then '注意要先判断更改前后的内容均不能为空，才能进行工作表名称的修改操作
Sheets(m1).Name = m2
Sheets(m2).Range("A1").Value = m2 '同步将子工作表的单元格A1的值也进行修改
End If
End Sub
////////////////////////////////////////////////////////////////////
在其他所有的子工作表中（子页或台账账页），插入相同的宏代码，如下：
--------------------------------------------------------
Dim sht As String, i '定义全局变量，用于获取子表页的工作表名称
Private Sub Worksheet_Activate()
Call LoginAction
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call SelectAction
End Sub
Private Sub Worksheet_Deactivate()
Call OutAction
End Sub
////////////////////////////////////////////////////////////////
通用模块内的宏代码如下（为方便代码维护，将原来子页中的代码以函数的方式集中写在模块内，子页只需一个调用函数即可执行操作）：
------------------------------------------------------
'本模块主要定义各子工作表需要执行的宏操作，以定义函数的方式统一在本模块中定义，是为方便代码维护考虑
'注意各子工作表需要用到的全局变量函数，如果涉及到本模块函数调用的，需在本模块中进行变量定义
Dim sht As String, i '定义全局变量，用于子表页在不同操作项下时调用结果用
'①定义子工作表进入时调用的函数
Sub LoginAction()
If Range("A1").Value = "请录入编码" Or Range("A1").Value = "" Then
'MsgBox "当前存货缺少编码，请即时设定正确编码！"
End If
sht = ActiveSheet.Name '获取当前子表页的工作表名称，以做为后面退出时隐藏调用
i = 1 '给变量一个初始值，以防止出现i无初始值导至后面sheet(i)运行出错
For x = 1 To Sheets.Count
If Sheets(x).Name = Sheets(sht).Name Then
i = x
'Exit For
End If
'MsgBox "当前名称：" & Sheets(i).Name '测试语句
Next
'MsgBox "当前进入序号:" & i
End Sub
'②定义子工作表单元格被选中时调用的函数
Sub SelectAction()
End Sub
'③定义离开子工作表时调用的函数
Sub OutAction()
'MsgBox "当前离开序值：" & i '测试语句
Sheet1.Select '选择目标工作表（即本处的汇总表/第1页）
If i <> 2 And i <> "" Then '即样表所在工作表对应的序号数值
Sheets(i).Visible = False '将当前的工作表隐藏起来（即离开的当前工作表页/已用变量取代）
End If
End Sub
'④定义复制方式增加子工作表页时调用的函数
Sub CopyShtAction()
Dim sName As String
sName = InputBox("请给新增的账页指定名称！")
Sheets("样表").Copy After:=Sheets(Sheets.Count)
'MsgBox "新增表默认名为：" & ActiveSheet.Name
If sName <> "" Then
ActiveSheet.Name = sName
MsgBox "新增账页成功，请注意保证账页名称与目录名称的对应性！"
Else
MsgBox "请即时设置新增账页的名称，并保证账页名称与目录名称的对应性！"
End If
'Sheets(sName).Select
'MsgBox "修改后名为：" & sht
End Sub
///////////////////////////////////////////////////////////// |
|
