ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[分享] 双栏页码(宏)

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-5-24 10:48 | 显示全部楼层 |阅读模式
* 同一页面设置双栏页码,适用于试卷等分栏文档。本宏于 Word2003 下运行通过。
  1. Sub 双栏页码()
  2.     ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
  3.     ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
  4.     With Selection
  5.         .Tables(1).Style = "普通表格"
  6.         .Tables(1).Select
  7.         .ParagraphFormat.Alignment = wdAlignParagraphCenter
  8.         .HomeKey Unit:=wdLine
  9.         .TypeText Text:="第"
  10.         .Fields.Add Range:=.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
  11.         .TypeText Text:="="
  12.         .Fields.Add Range:=.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
  13.         .TypeText Text:="Page"
  14.         .MoveRight Unit:=wdCharacter, Count:=2
  15.         .TypeText Text:="*2-1"
  16.         .Fields.ToggleShowCodes
  17.         .EndKey Unit:=wdLine
  18.         .TypeText Text:="页,共"
  19.         .Fields.Add Range:=.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
  20.         .TypeText Text:="="
  21.         .Fields.Add Range:=.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
  22.         .TypeText Text:="NumPages"
  23.         .MoveRight Unit:=wdCharacter, Count:=2
  24.         .TypeText Text:="*2"
  25.         .Fields.ToggleShowCodes
  26.         .EndKey Unit:=wdLine
  27.         .TypeText Text:="页"
  28.         .MoveRight Unit:=wdCell
  29.         .TypeText Text:="第"
  30.         .Fields.Add Range:=.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
  31.         .TypeText Text:="="
  32.         .Fields.Add Range:=.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
  33.         .TypeText Text:="Page"
  34.         .MoveRight Unit:=wdCharacter, Count:=2
  35.         .TypeText Text:="*2"
  36.         .Fields.ToggleShowCodes
  37.         .EndKey Unit:=wdLine
  38.         .TypeText Text:="页,共"
  39.         .Fields.Add Range:=.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
  40.         .TypeText Text:="="
  41.         .Fields.Add Range:=.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
  42.         .TypeText Text:="NumPages"
  43.         .MoveRight Unit:=wdCharacter, Count:=2
  44.         .TypeText Text:="*2"
  45.         .Fields.ToggleShowCodes
  46.         .EndKey Unit:=wdLine
  47.         .TypeText Text:="页"
  48.     End With
  49.     ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
  50.     ActiveWindow.View.TableGridlines = False
  51. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-5-24 10:51 | 显示全部楼层
* 请注意:如果复制代码到 VBE 中,代码前有无数个问号(?),只须立即删除此宏,然后新建文档,粘贴代码,全选,将 ^s 全部替换为" "(一个空格),再按“全部替换”,然后全选复制此文档中的代码到 VBE 中即可正常使用。

TA的精华主题

TA的得分主题

发表于 2019-5-25 08:45 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-5-26 00:59 | 显示全部楼层
谢谢楼上朋友!——但我发现,在单位 Win7(32bit)+Office2003 中运行 OK,但在家里 Winxp+Office2003 中运行出错!毛病就在“切换域代码”这句代码,暂时无法解决。如果有哪位朋友使用中出错,请手动或自行寻求解决。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-5-30 14:49 | 显示全部楼层
***  如果使用 1 楼宏代码出错,请下载下面的试卷模板,包含了双栏页码:
试卷模板A3(双栏页码)Win7.rar (2.61 KB, 下载次数: 18)

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-6-1 01:02 | 显示全部楼层
*** 昨晚用 360 杀毒和查木马后,今日发现《双栏页码》宏在家里使用正常了!现提供 XP 下模板:
试卷模板(双栏页码)Winxp.rar (2.56 KB, 下载次数: 17)
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-24 23:31 , Processed in 0.031418 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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