计算word文件打印页数 VBA实现

news2024/11/15 7:08:05

目录

  • 场景复现
    • 环境说明
    • 实现原理
    • 计算当前文件夹下所有word文件页数总和
    • 利用递归计算当前文件夹所有work文件页面数量
      • 几个BUG
      • 计算结果
      • 软件报价
        • 后话

场景复现

最近需要帮我弟打印高考资料,搜集完资料去网上打印,商家发出了这个计算页数的界面。我就好奇怎么实现的,计算的准不准,所以就动手自己用VBA代码实现了一下
在这里插入图片描述

环境说明

因为需要获取word文件的属性,所以需要引用work库。
在这里插入图片描述

在这里插入图片描述

实现原理

获取的是左下角页面的数量,然后把各个文件加起来。
在这里插入图片描述

计算当前文件夹下所有word文件页数总和

先实现计算当前文件夹下所有文件的,不会计算子文件夹。计算原理也很简单,直接要获取
在这里插入图片描述

Sub CountWordPagesInFolder()
    Dim folderPath As String
    Dim totalPages As Long
    Dim doc As Object
    Dim fileSystem As Object
    Dim folder As Object
    Dim file As Object

    totalPages = 0
    
    ' 设置文件夹路径
  folderPath = "C:\Users\Administrator\Desktop\读取页数"

    ' 创建FileSystemObject
    Set fileSystem = CreateObject("Scripting.FileSystemObject")
    Set folder = fileSystem.GetFolder(folderPath)



    ' 遍历文件夹中的每个文件
    For Each file In folder.Files
        Debug.Print file.Name
        If UCase(fileSystem.GetExtensionName(file.Name)) = "DOCX" Or _
           UCase(fileSystem.GetExtensionName(file.Name)) = "DOC" Then
            ' 打开Word文件
            'Set doc = wordApp.Documents.Open(file.Path)
            
            ' 创建Word应用程序实例
            Dim wordApp As Object
            Set wordApp = CreateObject("Word.Application")
            wordApp.Visible = False
            Set doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)
            
            ' 更新文档以确保准确计算页数
            'doc.Repaginate
            
            'Debug.Print file.Path
            ' 计算页数
            'totalPages = totalPages + doc.ComputeStatistics(1) ' wdStatisticPages = 1
            totalPages = totalPages + doc.ComputeStatistics(wdStatisticPages) ' wdStatisticPages = 1
            ' 关闭文档
            On Error Resume Next
            doc.Close
            If Err.Number <> 0 Then
                'Handle the error if any...
                Debug.Print "不正常正常关闭"
            End If
            On Error GoTo 0
        End If
    Next file

    ' 关闭Word应用程序
    wordApp.Quit

    ' 输出总页数
    MsgBox "Total pages in Word files: " & totalPages
End Sub


利用递归计算当前文件夹所有work文件页面数量

folderPath 改成自己的文件夹就行了。

Sub CountWordPagesInFolder()
    Dim folderPath As String
    Dim totalPages As Long
    Dim fileSystem As Object
    Dim folder As Object
    Dim wordApp As Object

    totalPages = 0
    
    ' 设置文件夹路径
    folderPath = "E:\work\高考真题\打印参考答案"

    ' 创建FileSystemObject
    Set fileSystem = CreateObject("Scripting.FileSystemObject")
    Set folder = fileSystem.GetFolder(folderPath)

    ' 创建Word应用程序实例
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = False

    ' 遍历文件夹及其子文件夹中的所有文件
    totalPages = TraverseFolders(folder, fileSystem, wordApp)

    ' 关闭Word应用程序
    wordApp.Quit

    ' 释放对象
    Set wordApp = Nothing
    Set fileSystem = Nothing
    Set folder = Nothing

    ' 输出总页数
    MsgBox "Total pages in Word files: " & totalPages
End Sub

Function TraverseFolders(folder As Object, fileSystem As Object, wordApp As Object) As Long
    Dim totalPages As Long
    Dim file As Object
    Dim subFolder As Object
    Dim doc As Object

    totalPages = 0
    
    ' 遍历文件夹中的每个文件
    For Each file In folder.Files
        Debug.Print file
        If UCase(fileSystem.GetExtensionName(file.Name)) = "DOCX" Or _
           UCase(fileSystem.GetExtensionName(file.Name)) = "DOC" Then
            ' 打开Word文件
            On Error Resume Next
            Set doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)
            If Err.Number <> 0 Then
                Debug.Print "无法打开文件: " & file.Path & " 错误信息: " & Err.Description
                Err.Clear
                On Error GoTo 0
                GoTo NextFile
            End If
            On Error GoTo 0
            
            ' 计算页数
            totalPages = totalPages + doc.ComputeStatistics(wdStatisticPages)
            
            ' 关闭文档
            'doc.Close SaveChanges:=False
        End If
NextFile:
    Next file
    
    ' 遍历子文件夹
    For Each subFolder In folder.SubFolders
        totalPages = totalPages + TraverseFolders(subFolder, fileSystem, wordApp)
    Next subFolder

    TraverseFolders = totalPages
End Function

几个BUG

'doc.Close SaveChanges:=False

doc对象正常来说用完就应关闭的,但是关闭后打开第二个文件机会报错
Set doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)
在这里插入图片描述
查询官网和GPT 都没给出很好的解释,然后我尝试关闭后每次重新创建一个wordApp对象读取文件信息,就不会报错。 估计是关闭文件会释放这个对象资源或者其他,肯定会影响。
Set wordApp = CreateObject(“Word.Application”)
wordApp.Visible = False

Sub CountWordPagesInFolder()
    Dim folderPath As String
    Dim totalPages As Long
    Dim doc As Object
    Dim fileSystem As Object
    Dim folder As Object
    Dim file As Object

    totalPages = 0
    
    ' 设置文件夹路径
  folderPath = "C:\Users\Administrator\Desktop\读取页数"

    ' 创建FileSystemObject
    Set fileSystem = CreateObject("Scripting.FileSystemObject")
    Set folder = fileSystem.GetFolder(folderPath)



    ' 遍历文件夹中的每个文件
    For Each file In folder.Files
        Debug.Print file.Name
        If UCase(fileSystem.GetExtensionName(file.Name)) = "DOCX" Or _
           UCase(fileSystem.GetExtensionName(file.Name)) = "DOC" Then
            ' 打开Word文件
            'Set doc = wordApp.Documents.Open(file.Path)
            
            ' 创建Word应用程序实例
            Dim wordApp As Object
            Set wordApp = CreateObject("Word.Application")
            wordApp.Visible = False
            Set doc = wordApp.Documents.Open(file.Path, ReadOnly:=True)
            
            ' 更新文档以确保准确计算页数
            'doc.Repaginate
            
            'Debug.Print file.Path
            ' 计算页数
            'totalPages = totalPages + doc.ComputeStatistics(1) ' wdStatisticPages = 1
            totalPages = totalPages + doc.ComputeStatistics(wdStatisticPages) ' wdStatisticPages = 1
            ' 关闭文档
            On Error Resume Next
            doc.Close
            If Err.Number <> 0 Then
                'Handle the error if any...
                Debug.Print "不正常正常关闭"
            End If
            On Error GoTo 0
        End If
    Next file

    ' 关闭Word应用程序
    wordApp.Quit

    ' 输出总页数
    MsgBox "Total pages in Word files: " & totalPages
End Sub

知道原因的大佬可以评论一下

计算结果

在这里插入图片描述
我计算了5025页,商家的软件只计算了 4699页!看来还是挺良心的。
顺藤摸瓜,我问了商家他们说是老板买软件计算的,这个是打印软件的官网https://www.nprint.cn/,这让我感觉到需求无处不在啊!

软件报价

在这里插入图片描述

后话

至于计算为什么不一样,我也联系和软件官方账号询问他们的计算算法是否有差异,目前还没回复。

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.coloradmin.cn/o/1967485.html

如若内容造成侵权/违法违规/事实不符,请联系多彩编程网进行投诉反馈,一经查实,立即删除!

相关文章

Robotaxi火了,中国智驾公司冲击全球无人车第一股

作者 |芦苇 编辑 |德新 全球Robotaxi第一股要来了&#xff0c;中国的文远知行可能比Waymo、Cruise更早上市。 7月末&#xff0c;文远知行向美国SEC提交招股书&#xff0c;此次发行由摩根士丹利、摩根大通及中金公司牵头&#xff0c;股票代码「WRD」。 作为全球第一家上市的R…

React 学习——路由跳转(Link、useNavigate)、跳转时传递参数(问号传递、path中冒号拼接)

需要四个页面&#xff1a;项目入口index.js文件&#xff0c;router配置路由跳转文件&#xff0c;article组件页面&#xff0c;login组件页面 1、项目入口index.js文件 注意&#xff1a;要安装这个依赖 react-router-dom import React from react import { createRoot } fro…

啥是RLFH标注、SFT标注、RM标注?一篇文章让你系统了解大模型标注

标注猿的第80篇原创 一个用数据视角看AI世界的标注猿 大家好&#xff0c;我是AI数据标注猿刘吉&#xff0c;一个用数据视角看AI世界的标注猿。 世界人工智能大会过后&#xff0c;感觉市场都变得热闹了起来呢&#xff0c;就连社区群里也变得热闹了&#xff0c;从找标注项…

深入浅出,大模型的规模与训练成本揭秘

导读 大模型是近几年非常火的一个AI名词&#xff0c;很多公司也在训练自己的大模型&#xff0c;但是训练一个大模型需要多少钱呢&#xff1f;本文从多个角度为大家拆解。 Title: Visualizing the size of Large Language Models Paper: https://medium.com/georgeanil/visuali…

学会这个Python库,接口测试so easy

前言 我们在做接口测试时&#xff0c;大多数返回的都是json属性&#xff0c;我们需要通过接口返回的json提取出来对应的值&#xff0c;然后进行做断言或者提取想要的值供下一个接口进行使用。 但是如果返回的json数据嵌套了很多层&#xff0c;通过查找需要的词&#xff0c;就…

【IEEE出版 | 高录用率 | 快速检索 | 有ISBN号!】2024年智能计算与数据挖掘国际学术会议 (ICDM 2024,9月20-22)

智能计算与数据挖掘是当今信息技术领域的研究热点&#xff0c;并在众多领域都有着广泛的应用&#xff0c;如金融、医疗、教育、交通等。随着大数据时代数据量爆炸式增长&#xff0c;如何从海量数据中提取有价值的信息&#xff0c;一直是需要迭代解决的问题。 2024年智能计算与…

Ampere推出512核AmpereOne Aurora处理器-定制AI引擎,支持HBM内存

随着各超大规模云服务商和主要云基础设施构建商纷纷设计自己的CPU和AI加速器&#xff0c;这让那些向他们销售计算引擎的厂商感受到了巨大压力。这其中不仅包括英特尔、AMD和英伟达&#xff0c;还包括Arm服务器芯片领域的新秀Ampere Computing&#xff0c;Ampere Computing与Int…

ICC2:如何报告sdc中的set_load

我正在「拾陆楼」和朋友们讨论有趣的话题,你⼀起来吧? 拾陆楼知识星球入口 来自星球提问: 如果要报告set_load设置的值,其实只要write_sdc就行,要是想在报告中看set_load产生的violation和影响,可以使用ICC2命令去报告。 report_delay_calculation

idea thymeleaf 热更新

1. **添加依赖**&#xff08;jeecgboot框架这步省略,不然报错&#xff09;&#xff1a; 确保在 pom.xml 中添加了 spring-boot-devtools 依赖&#xff1a; xml <dependency> <groupId>org.springframework.boot</groupId> <artifactI…

聊聊《思考,快与慢》

这是鼎叔的第一百零四篇原创文章。行业大牛和刚毕业的小白&#xff0c;都可以进来聊聊。 欢迎关注本专栏和微信公众号《敏捷测试转型》&#xff0c;星标收藏&#xff0c;大量原创思考文章陆续推出。 丹尼尔卡尼曼&#xff0c;是常年热门书籍《思考&#xff0c;快与慢》的作者…

MQTTX和Kimi集成

目录 概述 文本生成模型 Moonshot-v1 MQTTX Copilot的功能 一键错误分析 代码生成器 自动生成测试数据 解释器 点评 概述 MQTTX是我教学中使用的MQTT客户端&#xff0c;从两年来开课的情况看&#xff0c;还是相当好用的。昨天发现MQTTX现在已经支持和OpenAI API和Moons…

Docker安装OwnCloud私有云盘对接ceph

一、安装OwnCloud 我的安装包链接&#xff1a;https://pan.baidu.com/s/1cJO8WEonsw4gGQWgQaYzpw?pwd6bak 提取码&#xff1a;6bak 启动OwnCloud容器&#xff0c;没有镜像会自动下载 docker run -d -p 80:80 -v /home/owncloud:/var/www/html --name owncloud --restartalway…

SenseVoice实现语音转文字

之前使用了阿里的CosyVoice实现了文字生成语音和声音的复刻&#xff0c;这章使用阿里的的另一个工具&#xff0c;SenseVoice实现语音转文字&#xff0c;首先需要下载好软件&#xff0c;这里使用docker部署&#xff0c;下载好整合包后&#xff1a; 按照顺序执行 docker load -…

手把手教你用Windows安装Python,轻松开启编程之旅

大家好&#xff01;随着人工智能、大数据等领域的飞速发展&#xff0c;Python已成为最受欢迎的编程语言之一。今天&#xff0c;我就来教大家如何在Windows系统上轻松安装Python&#xff0c;让你迈出编程的第一步&#xff01; 一、准备工作 1. 确认你的Windows系统版本&#xf…

vue3配置permission.js和router、pinia实现路由拦截

场景 网站中&#xff0c;通常用户登录后后端返回token给前端&#xff0c;前端存储在本地并且在每次发送请求时携带&#xff0c;如果用户未登录&#xff08;没有token&#xff09;就想访问网站内部的网页&#xff0c;我们就需要做对应拦截。 配置Pinia 首先命令行下载pinia …

Web页面基础

Web页面基础 文章目录 Web页面基础一、HTML&#xff08;hyper text markup language&#xff09;的介绍二、HTML的标签一、基础标签二、其他标签1、基本类&#xff1a;2、文本类标签&#xff1a;3、列表标签&#xff1a;4、表格标签&#xff1a;5、媒体标签&#xff1a;6、嵌入…

小程序购物商城系统2024

小程序购物商城系统2024,编号weixin001 下载在最后 技术栈: js,java,mysql 展示: 下载地址: CSDN现在上传有问题,有兴趣的朋友先收藏.正常了贴上下载地址 备注:

非全尺寸婴儿床和游戏围栏美国CPC认证16CFR1121测试 ASTM F406报告

非全尺寸婴儿床和游戏围栏美国CPC认证16CFR1121测试 ASTM F406报告办理 什么是婴儿游戏围栏&#xff1f; 婴儿游戏围栏是一种框架式围栏&#xff0c;由网状织物或布料材质的非刚性护栏和底板组成。本政策适用于专为儿童提供睡眠和游戏环境而设计的游戏围栏&#xff08;高度低…

Stack Rolling Shutter是什么技术?

我们常见的有卷帘快门&#xff08;Rolling Shutter&#xff09;与全局快门&#xff08;Global Shutter&#xff09;&#xff0c;那思特威对外宣传的Stack Rolling Shutter是个什么技术&#xff1f; 官网查询不到相关信息。 英文百度查询结果是一些宣传性质的软文&#xff0c;bi…