|
|
|
我略作修饰了一下，你运行一下： Option Compare Text '不区分大小写
Option Explicit '显式变量声明
Sub PrintInWordPages()
Dim WdApp As Word.Application, WdDoc As Word.Document, i As Word.Range
Dim DocFullName As String, FindString As String, PageItem As String, DelText As String
Dim Fcount As Integer, J As Integer, FindString1 As String
On Error Resume Next '忽略错误
With Sheet10
.Cells(1, 16).FormulaR1C1 = "=DATE(YEAR(NOW()),MONTH(NOW()),0)" '写上月末日期
.Cells(1, 17).FormulaR1C1 = "=YEAR(RC[-1])&IF(LEN(MONTH(RC[-1]))=1,""0""&MONTH(RC[-1]),MONTH(RC[-1]))&DAY(RC[-1])"
FindString = .[m1] '获得搜索字符
Sheet3.Cells(1, 18) = .Cells(1, 17)
End With
Sheet3.Activate
Sheet3.Range(Cells(1, 18), Cells(1, 18)).NumberFormatLocal = "@"
'获得文档路径
DocFullName = ThisWorkbook.Path & "\往来对账单\" & Sheet3.Cells(1, 18) & ".Doc"
' MsgBox (FindString)
'如果找不到该文档,则友情提示并退出程序
' If Dir(DocFullName) = "" Then MsgBox "Excel没有找到" & DocFullName & " ,请确认WORD文档名是否正确!", vbExclamation, "Warnning": Exit Sub
Set WdApp = New Word.Application '定义一个新的WORD Application
' WdApp.Visible = True '显示程序窗口
'定义一个WdDoc文档,为指定打开的文档
Set WdDoc = WdApp.Documents.Open(FileName:=DocFullName, PasswordDocument:="gzw212535")
With WdDoc
With .Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With .PageSetup
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(0.9)
.BottomMargin = CentimetersToPoints(1.2)
.LeftMargin = CentimetersToPoints(1.4)
.RightMargin = CentimetersToPoints(1.4)
.PageWidth = CentimetersToPoints(24)
.PageHeight = CentimetersToPoints(28)
.VerticalAlignment = wdAlignVerticalTop
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
.LayoutMode = wdLayoutModeLineGrid
End With
DelText = "In case error*changed."
With .Content.Find '查找
.ClearFormatting '清除查找格式
.MatchWildcards = True '使用通配符
'全部替换为空格
.Execute FindText:=DelText, ReplaceWith:="", Replace:=wdReplaceAll
End With
For Each i In .Words '遍历每个词组
If i Like "[A-Z]*" And Not i Like "*#*" Then i = VBA.Space(Len(i))
Next
With .Content.Find '查找
.ClearFormatting '清除查找格式
'将如NO.等形式的.替换为空格
.Execute FindText:=" .", ReplaceWith:=" ", Replace:=wdReplaceAll
End With
With .Content.Find '在全文中查找
.ClearFormatting '清除查找格式
For J = 6 To 0 Step -1 '循环
FindString1 = VBA.Space(2 ^ J) & "^p" '生成指定的查找项目文字
'全部替换"
.Execute FindText:=FindString1, ReplaceWith:="^p", Replace:=wdReplaceAll
Next
End With
.Close True
End With
WdApp.Quit '退出WORD
Set WdApp = Nothing '释放对象变量
End Sub
'----------------------注:由于你调整WORD文档页面设置,故WORD主程序窗口我没有将VISIBLE属性设置为TRUE.另,你的EXCEL中的代码也不是很精简,需要进一步改进.WORD中的代码与EXCEL中还是有比较大的区别的,不能生搬硬套的. |
|
楼主: 班长
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-4-30 07:09
楼主