|
你的这种情况，本来就比较特殊，就是英文与数字一起时，不可以删除，这样，只能以遍历的形式解决。
我重新再修饰了一下，我实测为：四页纸3秒（直接在WORD中） 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, aPar As Word.Paragraph
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
DelText = "In case error*changed."
With .Content.Find '查找
.ClearFormatting '清除查找格式
.MatchWildcards = True '使用通配符
'全部替换为空格
.Execute FindText:=DelText, ReplaceWith:="", Replace:=wdReplaceAll
End With
For Each aPar In .Paragraphs
If aPar.Range Like "*[A-Z]*" Then
For Each i In aPar.Range.Words '遍历每个词组
If i Like "[A-Z]*" And Not i Like "*#*" Then i = VBA.Space(Len(i))
Next
End If
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
.Content.Font.Name = "宋体"
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)
.GutterPos = wdGutterPosLeft
.LayoutMode = wdLayoutModeLineGrid
End With
.Close True
End With
WdApp.Quit '退出WORD
Set WdApp = Nothing '释放对象变量
End Sub
'----------------------
也就是300页纸的文档，五分钟应该可以解决（我的电脑太次）
[此贴子已经被作者于2005-5-2 6:16:10编辑过] |
楼主: 班长
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-4-30 07:09
楼主