blog.cfosea.cn
尘埃在线个人博客
welcome to read the blog—http://blog.cfosea.cn
[电脑网络]关于EXCEL链接进入隐藏工作表的宏代码
※尘埃※ 发表于:2013/3/20 9:58:10 阅读(1678)次 评论(0)条 编辑 删除 私密 禁评 置顶 
本文链接:
     整了快一天,通过百度的学习了解和自己琢磨测试,总算第一次偿试着弄出了一段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
/////////////////////////////////////////////////////////////
楼主签名
有些个性,但没怎么表现!有些背叛,但一直都很守法! 有些冷默,却天性怜悯动情!想摆脱普通与平凡,但却依然徘徊未进!坚持原则,但不失灵活性!无为,但不失上进心!无情,却不失友情!想拥有钱,但却不迷于钱!
  用户登录 用户注册 进入博客 
名 称: 性 别: QqNum: 邮 箱:
个人主页: 来自地区: 头像选择: >>‖‖》》全部头像列表《《‖‖
 提示:如果您在本站注册了用户名,将允许修改自己的评论记录,同时还能在本网站评论及留言处显示您的个性签名!