ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 154|回复: 11

[求助] 求老师帮助代码,谢谢!

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-12-3 09:37 | 显示全部楼层 |阅读模式
具体情况在附件,谢谢!

新建文件夹 (2).zip

65.67 KB, 下载次数: 14

TA的精华主题

TA的得分主题

发表于 2019-12-3 15:58 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-12-4 15:50 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-12-4 20:30 | 显示全部楼层
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Target.Count <> 1 Then Exit Sub
  3.     If Target.Row = 1 Then Exit Sub
  4.     If Target.Column <> 1 Then Exit Sub
  5.     If Len(Target) = 0 Then Exit Sub
  6.     pth = ThisWorkbook.Path
  7.     Application.EnableEvents = False
  8.     fn = Dir(pth & "\学历" & Target.Value & ".*")
  9.     If fn <> "" Then
  10.         ActiveSheet.Hyperlinks.Add Anchor:=Target.Offset(0, 1), Address:=pth & "\学历" & fn, _
  11.         TextToDisplay:=Target.Value
  12.     End If
  13.     fn = Dir(pth & "\聘书" & Target.Value & ".*")
  14.     If fn <> "" Then
  15.         ActiveSheet.Hyperlinks.Add Anchor:=Target.Offset(0, 2), Address:=pth & "\聘书" & fn, _
  16.         TextToDisplay:=Target.Value
  17.     End If
  18.     Application.EnableEvents = True
  19. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2019-12-4 20:31 | 显示全部楼层
附件内容供参考。。。。。。

新建文件夹 (2).zip

80.97 KB, 下载次数: 6

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-12-5 10:33 | 显示全部楼层
liulang0808 发表于 2019-12-4 20:31
附件内容供参考。。。。。。

老师,能否再修改下,有N行N列,有部分有文件的,没文件的显示为空值

TA的精华主题

TA的得分主题

发表于 2019-12-5 11:59 | 显示全部楼层
cdnyrg 发表于 2019-12-5 10:33
老师,能否再修改下,有N行N列,有部分有文件的,没文件的显示为空值

没有明白楼主的N行N列是什么意思的

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-12-5 14:57 | 显示全部楼层
liulang0808 发表于 2019-12-5 11:59
没有明白楼主的N行N列是什么意思的

老师,你能否帮我改一下,我只做聘书列,有文件显示为聘书,没文件的显示为空值。每运行一次都重新记录

TA的精华主题

TA的得分主题

发表于 2019-12-5 18:37 | 显示全部楼层
    fn = Dir(pth & "\学历" & Target.Value & ".*")
    If fn <> "" Then
        ActiveSheet.Hyperlinks.Add Anchor:=Target.Offset(0, 1), Address:=pth & "\学历" & fn, _
        TextToDisplay:=Target.Value
    End If

这个是学历部分,删除,剩下仅有聘书了

TA的精华主题

TA的得分主题

发表于 2019-12-6 07:35 | 显示全部楼层
  1. Sub 按钮2_Click()

  2.     arr = [a1].CurrentRegion
  3.     pth = ThisWorkbook.Path
  4.     Application.ScreenUpdating = False
  5.     For j = 2 To UBound(arr)
  6.         Cells(j, 2) = ""
  7.         If Len(arr(j, 1)) > 0 Then
  8.             fn = Dir(pth & "\聘书" & arr(j, 1) & ".*")
  9.             If fn <> "" Then
  10.                 ActiveSheet.Hyperlinks.Add Anchor:=Cells(j, 2), Address:=pth & "\聘书" & fn, _
  11.                 TextToDisplay:=arr(j, 1)
  12.             End If
  13.         End If
  14.     Next
  15.     Application.ScreenUpdating = True

  16. End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-12-10 01:59 , Processed in 1.403638 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表