请教：word向excel拷贝文字的VBA代码如何写？

这帖子发在excel BA版，被版主转帖到这了。

我是想学一下在word中控制excel 或者在excel中控制word，大家能否帮我写一段示范代码？

要求（这回变一下）：

在excel环境下编一段VBA。

一、打开制定word文档，如C：\1.doc。

二、查找里面的一句话，将这句话所在的段落扩展选中，将选中内容设为range。

三、对range复制，粘贴到excel的表格中。

word的range和excel的range一样吗？定义语句如何写？

定义一个word 的document对象该如何写？

如何用with 语句？

[此贴子已经被作者于2008-6-20 7:23:06编辑过]

Sub a()
Dim wd As Object  ’如果定义为 word.application则有时可用，有时显示未定义类型，是什么原因呢？

Set wd = CreateObject("word.application")
With wd
    .Visible = True
    .documents.Add
    .Selection.typetext "wwwwwwwww" & Chr(13) & "eeeeeee"
    .Selection.homekey unit:=wdstory   ’运行到这句时就显示错误代码 4120 参数无效（同样情况还发生在expand、find.execute等上。是什么原因呢？应该如何写？
End With
End Sub

在excel的环境中，引用word的类库。

方法：

1、工具、引用

2、勾选“Micrsoft Word 11.0 Object Library”，单击确定。

在Excel2003下测试正常。

谢谢版主，成功了

写了常用的三种方法，从Excel中调用Word Automation对象

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-6-23 5:33:03
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0415^The Code CopyIn [Excel_Moudle1]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
'在excel环境下编一段VBA?
'打开F:\1.doc
'二、查找里面的一句话，将这句话所在的段落扩展选中，将选中内容设为range。
'三、对range复制，粘贴到excel的表格中。
'word的range和excel的range一样吗？定义语句如何写？
'定义一个word 的document对象该如何写？
'如何用with 语句？

Sub Example1()
'使用前期绑定的Automation对象
'即在代码运行前该代码所在工程中已经引用了Microsoft Word 11.0 Object Library
'VBE/工具/引用Microsoft Word 11.0 Object Library
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdRange As Word.Range
    Dim wdExists As Boolean
    Dim myFindText As String
    Dim myPath As String
    Dim xlsRange As Range
    On Error Resume Next    '忽略错误(启用错误处理)
    myPath = "F:\1.doc"    '文件路径和文件名
    myFindText = "document"
    wdExists = True    ' 初始化变量,指明默认情况下,Word是已经打开的
    Set xlsRange = ThisWorkbook.Sheets(1).Range("A1")
    Set wdApp = GetObject(, "Word.Application")    '取得对Word应用程序的引用
    If Err.Number <> 0 Then    '如果Word没有打开,则GetObject函数将返回一个错误
        Err.Clear    '清除错误
        On Error GoTo 0    '关闭错误处理
        Set wdApp = CreateObject("Word.Application")    '创建一个对Word Application对象的引用
        wdApp.Visible = True    '默认情况下,CreateObject后WORD的Visible=False''如果需要程序在隐蔽情况下进行,不必设置此行代码
        wdExists = False
    End If
    '如果不希望以隐藏方式打开Word文档时,可将参数Visible设置为True或者省略
    Set wdDoc = wdApp.Documents.Open(FileName:=myPath, Visible:=False)
    Set wdRange = wdDoc.Content
    With wdRange.Find
        .ClearFormatting    '清除格式
        .MatchWildcards = False    '不使用通配符
        .Text = myFindText
        If .Execute = False Then GoTo Ex_SUB    '如果没有成功查找到(文档中没有此关键文字),则跳转到指定的行标签处
    End With
    Set wdRange = wdRange.Paragraphs(1).Range    '定义为查找内容所在段落区域
    wdRange.SetRange wdRange.Start, wdRange.End - 1    '定义为不包含段落标记的文本区域
    xlsRange.Value = wdRange.Text
Ex_SUB:        '行标签
    wdDoc.Close False    '关闭并不保存Word文档
    If wdExists = False Then wdApp.Quit    '如果Word是用CreatObject方法打开的,程序执行结束后就要关闭它
End Sub
'----------------------
Sub Example2()
'使用前期绑定的Automation对象并使用New关键字隐式声明(创建)对象
'即在代码运行前该代码所在工程中已经引用了Microsoft Word 11.0 Object Library
'VBE/工具/引用Microsoft Word 11.0 Object Library
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Dim wdRange As Word.Range
    Dim myFindText As String
    Dim myPath As String
    Dim xlsRange As Range
    myPath = "F:\1.doc"    '文件路径和文件名
    myFindText = "document"
    Set xlsRange = ThisWorkbook.Sheets(1).Range("A1")
    '如果不希望以隐藏方式打开Word文档时,可将参数Visible设置为True或者省略
    Set wdDoc = wdApp.Documents.Open(FileName:=myPath, Visible:=False)
    Set wdRange = wdDoc.Content
    With wdRange.Find
        .ClearFormatting    '清除格式
        .MatchWildcards = False    '不使用通配符
        .Text = myFindText
        If .Execute = False Then GoTo Ex_SUB    '如果没有成功查找到(文档中没有此关键文字),则跳转到指定的行标签处
    End With
    Set wdRange = wdRange.Paragraphs(1).Range    '定义为查找内容所在段落区域
    wdRange.SetRange wdRange.Start, wdRange.End - 1    '定义为不包含段落标记的文本区域
    xlsRange.Value = wdRange.Text
Ex_SUB:        '行标签
    wdDoc.Close False    '关闭并不保存Word文档
    wdApp.Quit    '总是退出该对象
End Sub
'----------------------

Sub Example3()
'使用后期绑定的方法调用Word对象
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim wdRange As Object
    Dim wdExists As Boolean
    Dim myFindText As String
    Dim myPath As String
    Dim xlsRange As Range
    On Error Resume Next    '忽略错误(启用错误处理)
    myPath = "F:\1.doc"    '文件路径和文件名
    myFindText = "document"
    Set xlsRange = ThisWorkbook.Sheets(1).Range("A1")
    wdExists = True    ' 初始化变量,指明默认情况下,Word是已经打开的
    Set wdApp = GetObject(, "Word.Application")    '取得对Word应用程序的引用
    If Err.Number <> 0 Then    '如果Word没有打开,则GetObject函数将返回一个错误
        Err.Clear    '清除错误
        On Error GoTo 0    '关闭错误处理
        Set wdApp = CreateObject("Word.Application")    '创建一个对Word Application对象的引用
        '        wdApp.Visible = True    '默认情况下,CreateObject后WORD的Visible=False'        ''如果需要程序在隐蔽情况下进行,不必设置此行代码
        wdExists = False
    End If
    Set xlsRange = ThisWorkbook.Sheets(1).Range("A1")
    '如果不希望以隐藏方式打开Word文档时,可将参数Visible设置为True或者省略
    Set wdDoc = wdApp.Documents.Open(FileName:=myPath, Visible:=False)
    Set wdRange = wdDoc.Content
    With wdRange.Find
        .ClearFormatting    '清除格式
        .MatchWildcards = False    '不使用通配符
        .Text = myFindText
        If .Execute = False Then GoTo Ex_SUB    '如果没有成功查找到(文档中没有此关键文字),则跳转到指定的行标签处
    End With
    Set wdRange = wdRange.Paragraphs(1).Range    '定义为查找内容所在段落区域
    wdRange.SetRange wdRange.Start, wdRange.End - 1    '定义为不包含段落标记的文本区域
    xlsRange.Value = wdRange.Text
Ex_SUB:        '行标签
    wdDoc.Close False    '关闭并不保存Word文档
    wdApp.Quit    '总是退出该对象
End Sub
'----------------------

'实例附件:

sxwrGNpT.rar (12.08 KB)
请教：word向excel拷贝文字的VBA代码如何写？
下载次数: 43

2008-6-23 05:35