请教各位老师，怎样将超链接单元格引用的工作表名称，输入到固定单元格

wyzdddl

桌面.7z (162.13 KB, 下载次数: 17)

2012-11-2 21:30 上传

点击文件名下载附件

请教各位老师！
销售工作簿“目录”工作表中，单击“客户”姓名，在不影响“超链接”的情况下，自动将该单元格的超链接所引用的内容（如：曹大鹏的引用内容“6”），粘贴到“配件工作簿”的“配件资料”工作表的“C2"单元格中.
请看附件

zhaogang1960

是在配件工作簿已经打开的状态下？

1. Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
   
2.     Dim wb As Workbook
   
3.     On Error Resume Next
   
4.     Set wb = Workbooks("配件工作簿.xlsm")
   
5.     If wb Is Nothing Then
   
6.         MsgBox "配件工作簿.xlsm没有打开，请检查"
   
7.         Exit Sub
   
8.     End If
   
9.     wb.Sheets("配件资料").[c2] = Replace(Split(Target.SubAddress, "!")(0), "'", "")
   
10.     wb.Activate
    
11.     wb.Sheets("配件资料").Activate
    
12. End Sub
    

复制代码

zhaogang1960

请看附件
11.rar (173.97 KB, 下载次数: 108)

2012-11-2 21:54 上传

点击文件名下载附件

wyzdddl

谢谢版主，明天试用一下

wyzdddl

版主您好，能在每个语句后加上注释吗，以帮助我理解
wb.Sheets("配件资料").[c2] = Replace(Split(Target.SubAddress, "!")(0), "'", "") 这句更蒙。

zhaogang1960

wyzdddl 发表于 2012-11-3 07:51
版主您好，能在每个语句后加上注释吗，以帮助我理解
wb.Sheets("配件资料").[c2] = Replace(Split(Target. ...

1. Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) 'FollowHyperlink 事件，当单击工作表上的任意超链接时，发生此事件。
   
2.     Dim wb As Workbook '声明工作簿变量wb
   
3.     On Error Resume Next '忽略错误
   
4.     Set wb = Workbooks("配件工作簿.xlsm") '把"配件工作簿.xlsm"工作簿赋值给wb
   
5.     If wb Is Nothing Then '如果"配件工作簿.xlsm"工作簿没有打开
   
6.         MsgBox "配件工作簿.xlsm没有打开，请检查" '提示
   
7.         Exit Sub '退出程序
   
8.     End If
   
9.     wb.Sheets("配件资料").[c2] = Replace(Split(Target.SubAddress, "!")(0), "'", "") 'SubAddress超链接相关联的位置，含有工作表信息，在感叹号!左边
   
10.     wb.Activate '激活"配件工作簿.xlsm"工作簿
    
11.     wb.Sheets("配件资料").Activate '激活"配件资料"工作表
    
12. End Sub
    

复制代码

wyzdddl

谢谢您，版主，受益匪浅