在word中查询excel 单元格的问题？

班长

请教各位：

1、工作设想： 在EXCEL中打开了一个word 文档，查找到excel中 D2 中的数据(文本格式)在work中所在的页数，并打印该页。(注：word 中有几百页，每页都有一个编号，并且有时几页都是同一个编号)

2、求教问题：

如何打印出文档中包含 D2 中的数据(也就是输入的编号) 的所有页数。

谢谢指教!

守柔

你的数据是否在WORD中具有惟一性？？

请上传你的附件，我好帮你处理（注意：上传的EXCEL工作薄与WORD文档，必须有代表性）！

班长

守柔斑主，有关问题见附件，首先致以深深地谢意!!

5gxcKP04.rar (32.06 KB, 下载次数: 20)

2005-4-23 16:55 上传

点击文件名下载附件
在word中查询excel 单元格的问题？

另：word文档中有个宏，问题也在里面。

[此贴子已经被作者于2005-4-23 16:55:51编辑过]

守柔

WORD文档在打印时会出现“第一节的页边距设于可打印区域之外”的对话框，所以，我在代码中，没有隐藏WORD APPLICATION窗口，我只是模拟打印，请楼主再实测一下。

关于WORD宏替换空格的事宜，我稍后再作回复。

以下代码分别在SHEET1的CHANGE事件中和该工作薄的模块1中。

其中的模块1，需要确认引用了microsoft word 10.0(版本而异）object library

以下代码供参考： Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$4" Then If MsgBox("您确信在" & [D3] & ".Doc文档中," & vbCrLf & "搜索此账号:[" & [D4] & "]并打印之?", vbYesNo + vbExclamation) = vbYes Then Call PrintInWordPages End If End If End Sub '---------------------- Sub PrintInWordPages() Dim WdApp As Word.Application, WdDoc As Word.Document Dim DocFullName As String, FindString As String, PageItem As String Dim Fcount As Integer On Error Resume Next '忽略错误 '获得文档路径 DocFullName = ThisWorkbook.Path & "\" & ActiveSheet.[D3] & ".Doc" FindString = ActiveSheet.[D4] '获得搜索字符 '如果找不到该文档,则友情提示并退出程序 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) With WdDoc.ActiveWindow.Selection .HomeKey wdStory '移到文档首位置 .Find.ClearFormatting '清除查找格式 Do While .Find.Execute(findtext:=FindString) '搜索指定字符 '页数为字符型文本累加 PageItem = PageItem & "," & .Information(wdActiveEndPageNumber) Fcount = Fcount + 1 '计数 Loop '如果没有找到,则友情提示 If Fcount = 0 Then MsgBox "Word没有搜索到您要查找的账号[" & FindString & "],请核对!", vbExclamation, "Warnning" '去掉第一个","号 PageItem = VBA.Mid(PageItem, 2, Len(PageItem) - 1) ' MsgBox PageItem 'WdDoc打印指定页数 WdDoc.PrintOut Range:=wdPrintRangeOfPages, Copies:=1, Pages:=PageItem WdDoc.Close False End With WdApp.Quit '退出WORD Set WdApp = Nothing '释放对象变量 End Sub '----------------------

j0V7G1jy.rar (11.24 KB, 下载次数: 34)

2005-4-24 06:26 上传

点击文件名下载附件
在word中查询excel 单元格的问题？

[此贴子已经被作者于2005-4-24 6:26:01编辑过]

班长

非常感谢，我先研究一下，如有不懂的，还望不吝赐教!

班长

[em17] , 经过实测，完美超乎想象!

还望斑主能在百忙之中抽再把关于替换空格的问题解决一下!!

seenosee

强，赞一个！

[em22]

守柔

以下是引用班长在2005-4-25 19:44:00的发言：

[em17] , 经过实测，完美超乎想象!

还望斑主能在百忙之中抽再把关于替换空格的问题解决一下!!

守柔斑主，上面是我录制的一个宏，是想把文档中的空格全部替换掉，但这样替换太慢了。我想，能不能用个循环， '第一次替换64个空格，第二个替换32个，第三次替换16个，第四次替换8个，第五次替换4个，第六次替换2个，第七次替换1个。 '请你帮帮忙!

我只是按照你的要求，简单地做了一下，请参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-4-26 4:17:58 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub ExampleToReplaceSpace() Dim i As Integer, FindString As String Application.ScreenUpdating = False '关闭屏幕更新 With ActiveDocument.Content.Find '在全文中查找 .ClearFormatting '清除查找格式 For i = 6 To 0 Step -1 '循环 FindString = VBA.Space(2 ^ i) '生成指定的查找项目文字 '全部替换 .Execute findtext:=FindString, replacewith:="", Replace:=wdReplaceAll Next End With Application.ScreenUpdating = True '恢复屏幕更新 End Sub '----------------------

班长

感谢的话真不知说什么好了，向你致敬! 我又加了一点，用来把回车键前面的空格替换掉。

Sub ExampleToReplaceSpace() Dim i As Integer, FindString As String Application.ScreenUpdating = False '关闭屏幕更新 With ActiveDocument.Content.Find '在全文中查找 .ClearFormatting '清除查找格式 For i = 6 To 0 Step -1 '循环 FindString = VBA.Space(2 ^ i) &"^p" '生成指定的查找项目文字 '全部替换 .Execute findtext:=FindString, replacewith:="^P", Replace:=wdReplaceAll Next End With Application.ScreenUpdating = True '恢复屏幕更新 End Sub

[此贴子已经被作者于2005-4-26 22:54:58编辑过]