请参考:(请确保所需的文档在同一文件夹下）
Sub 批量格式设置()
'此代码为指定文件夹中所有选取的WORD文件的进行格式设置
Dim MyDialog As FileDialog, vrtSelectedItem As Variant, Doc As
Document
' On Error Resume Next '忽略错误
'定义一个文件夹选取对话框
Set MyDialog =
Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear '清除所有文件筛选器中的项目
.Filters.Add '所有 WORD 文件', '*.doc', 1 '增加筛选器的项目为所有WORD文件
.AllowMultiSelect = True '允许多项选择
If .Show = -1 Then '确定
Application.ScreenUpdating = False
For Each vrtSelectedItem In .SelectedItems '在所有选取项目中循环
Set Doc = Documents.Open(FileName:=vrtSelectedItem,
Visible:=False)
With Doc
With .PageSetup '进行页面设置
.Orientation = wdOrientPortrait '页面方向为纵向
.TopMargin = CentimetersToPoints(4.1) '上边距为4.1cm
.BottomMargin = CentimetersToPoints(4.1) '下边距为4.1cm
.LeftMargin = CentimetersToPoints(3.05) '左边距为3.05cm
.RightMargin = CentimetersToPoints(3.05) '右边距为3.05com
.Gutter = CentimetersToPoints(0) '装订线0cm
.HeaderDistance = CentimetersToPoints(1.5)
'页眉1.5cm
.FooterDistance = CentimetersToPoints(1.75) '页脚1.75cm
.PageWidth = CentimetersToPoints(21) '纸张宽21cm
.PageHeight = CentimetersToPoints(29.7) '纸张高29.7cm
.SectionStart = wdSectionNewPage '节的起始位置：新建页
.OddAndEvenPagesHeaderFoo
ter = False '不勾选“奇偶页不同”
.DifferentFirstPageHeader
Footer = False '不勾选“首页不同”
.VerticalAlignment = wdAlignVerticalTop '页面垂直对齐方式为“顶端对齐”
.SuppressEndnotes = False '不隐藏尾注
.MirrorMargins = False '不设置首页的内外边距
.BookFoldRevPrinting = False '不设置手动双面打印
.BookFoldPrintingSheets = 1 '默认打印份数为1
.GutterPos = wdGutterPosLeft '装订线位于左侧
.LayoutMode = wdLayoutModeLineGrid '版式模式为“只指定行网格”
End With
.Close True
End With
Next
Application.ScreenUpdating = True
End If
End With
MsgBox '格式化文档操作设置完毕!', vbInformation
End Sub
posted @ 2011-06-06 21:20 半点忧伤 阅读(89) 评论(0)
编辑
VBA实现批量修改Word文档的页脚内容 功能示例：
有很多个
doc文档，页脚的电话变了，如原电话是
4007339339，现在变成
4007168339了，要实现批量替换，可使用此程序。
使用说明：
1、
复制下面程序代码到VBA里后，点“工具”－“宏”－“宏”－“
change”－“运行”
2、 输入目录
(不要输入根目录，要不速度会很慢
)
3、 输入要查找的内容
4、 输入的替换成你要的内容
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'下面是程序代码，复制到Word的VBA里
'此子程序放在Word对象里
Option Explicit
Sub change()
Dim s As String
Dim wb As Object
Dim i As Long
Dim load As String
Dim find As String
Dim change As String
load = InputBox('输入要修改页脚的文件夹路径，自动扫描子文件夹－－－－－－－－－－－－－垃圾桶丁2009-3-8')
'要变更的目录
find = InputBox('输入要查找的页脚内容')
'查找的内容
change = InputBox('请问要替换成什么内容？') '替换的内容
Set wb = Application.FileSearch
With wb
.NewSearch
.LookIn =
load
.SearchSubFolders = True
.FileName =
'*.doc'
.FileType =
msoFileTypeExcelWorkbook
s
If
.Execute() > 0 Then
For i = 1 To .FoundFiles.Count
On Error
Resume Next
s = .FoundFiles(i)
Call Macro1(s, find, change)
Next i
End
If
End With
End Sub
'此子程序放在模块里
Option Explicit
Sub Macro1(s As String, find As String, change As String)
Documents.Open FileName:=s,
ConfirmConversions:=False, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:='',
_
PasswordTemplate:='', Revert:=False, WritePasswordDocument:='',
_
WritePasswordTemplate:='', Format:=wdOpenFormatAuto,
XMLTransform:=''
If ActiveWindow.View.SplitSpecial <>
wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type =
wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True
Then
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView =
wdSeekCurrentPageHeader
End If
Selection.find.ClearFormatting
Selection.find.Replacement.ClearFormatting
With Selection.find
.Text =
find '查找的内容
.Replacement.Text = change '替换的内容
.Forward =
True
.Wrap =
wdFindContinue
.Format =
False
.MatchCase
= False
.MatchWholeWord = False
.MatchByte
= True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute
Replace:=wdReplaceAll
ActiveWindow.Close (wdSaveChanges)
End Sub
posted @ 2011-06-06 21:18 半点忧伤 阅读(98) 评论(2)
编辑
为了赶编一个图册,我们定了一个图片格式,图片全部存在硬盘上,每个图片均有一定的编号,如果手工实现,
至少要24小时以上,
中间还会出现DOC文件澎湃死机,想起来头就大.根据工作的流程,定了个索引文件格式,写了个VBA脚本,实现了(1)在WORD中插入表格(关键是单元
格合并);(2)在WORD中插入文本框(浮于表格与图片上);(3)定义索引文件的格式(编号\图片\说明);(4)在WORD中读取索引文件格式.
结果,完成一个图册文件的制作,
只用了不到20分钟,真是轻松.在工作有好的帮手真的非常重要,thank
QCJ.下面是它的VBA代码,等到有时间时,用VC把它实现打包,让更多的人更简单地用吧.
==================================
Sub test()
'
' test Macro
' 宏在 2007-7-16 由 FtpDown 录制
'插入表格
Dim filename As String, str1() As String, tmp As String, i As
Integer
Dim photoimg As String, gisimg As String
filename = 'c:\set.txt' '这里是文本文件所在路径位置
Open filename For Input As 1
Do Until EOF(1)
Line Input #1, tmp
str1 = Split(tmp, ',')
photoimg = str1(2) & '\1.jpg'
gisimg = str1(2) & '\2.jpg'
Selection.Collapse Direction:=wdCollapseStart
Set myTable = ActiveDocument.Tables.Add(Range:=Selection.Range,
_
NumRows:=2, NumColumns:=3,
DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=
_
wdAutoFitFixed)
'修改表格的高宽
myTable.Rows(1).HeightRule = wdRowHeightAtLeast
myTable.Rows(1).Height = CentimetersToPoints(8.62)
