设为首页收藏本站|繁體中文

Excel 技巧网

 找回密码
 注册

QQ登录

只需一步,快速开始

手机号码,快捷登录

查看: 2299|回复: 8

[Word] 如何为当前路径下的所有Word文档名称添加相应的总页数呢?

[复制链接]
发表于 2014-3-31 23:56:30 | 显示全部楼层 |阅读模式
  • 署名作者: 0Mouse
  • 版权声明: 版权归本站与作者共有 除本站官方外非作者本人转载须经许可并注明出处
  • 本文来自:
  • 引用作品:
  • 适用版本: 2010 
  • 语言环境: 简体中文
  • 学习方法: 掌握Excel技巧的关键是动手操作 | 下载 ≠ 知识


  • 免费注册成为本站会员,享用更多功能,结识更多Office办公高手!

    您需要 登录 才可以下载或查看,没有帐号?注册

    x
    Q:如何为当前路径下的所有Word文档(扩展名为.docx)名称添加相应的总页数呢?
    添加前:
    添加前.jpg
    添加后:
    添加后.jpg
    A:运用VBA批量处理,代码如下:
    1. Sub 为当前路径下的所有Word文档名称添加相应的总页数()
    2.     Dim sPath   As String
    3.     Dim sName   As String
    4.     Dim sName2  As String
    5.     Dim Doc     As Document
    6.     Dim Arr()   As String
    7.     Dim i       As Long
    8.     Dim j       As Long
    9.     sPath = ThisDocument.Path & ""
    10.     sName = Dir(sPath & "*.docx")
    11.     ReDim Arr(1 To 1000)
    12.     Do While sName <> ""
    13.             i = i + 1
    14.             If i > UBound(Arr) Then ReDim Preserve Arr(1 To UBound(Arr) + 1000)
    15.             Arr(i) = sName
    16.         sName = Dir
    17.     Loop
    18.     If i Then
    19.         For j = 1 To i
    20.             sName = sPath & Arr(j)
    21.             Set Doc = Documents.Open(sName)
    22.             sName2 = Left(sName, InStrRev(sName, ".") - 1) & _
    23.                      "_共" & Format(Selection.Information(wdNumberOfPagesInDocument), "00") & "页.docx"
    24.             Doc.Close 0
    25.             Name sName As sName2
    26.         Next j
    27.         MsgBox "处理完毕", vbInformation, "xqoa"
    28.     End If
    29.     Erase Arr
    30. End Sub
    复制代码

    附件: 为当前路径下的所有Word文档名称添加相应的总页数.rar (82.81 KB, 下载次数: 8)
     楼主| 发表于 2014-4-1 00:10:52 | 显示全部楼层
    亡者天下 发表于 2014-4-1 00:06
    最后几分钟秒杀啊!

    几个月前的最后一个夜晚,不幸被天南终结,今天芐雨成了受害者了。
    回复 支持 反对

    使用道具 举报

    发表于 2014-4-1 11:53:44 | 显示全部楼层
    亡者天下 发表于 2014-4-1 00:06
    最后几分钟秒杀啊!

    本来是能拿三个的
    回复 支持 反对

    使用道具 举报

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

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    Archiver|手机版|Excel技巧网 ( 闽ICP备08107682号-2

    GMT+8, 2019-12-7 00:09

    Powered by Discuz! X3.4

    © 2001-2017 Comsenz Inc.

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