将数据从Excel复制到打开的Word文档
是否有一种简单（非常）的方式来执行以下操作：
1.突出显示Word文档中的某些文本
2.按（自定义）按钮
3a。从Excel工作表中的特定单元格读取数据（Excel文件始终具有相同的名称，行由Word文档的数字字符定义）并替换突出显示的数据。
3b。或者，不是在Word文档中突出显示文本，而是具有唯一的文本。
例如，我打开一个名为WordDoc6的文档。
那里有文字说替换此文字（可以突出显示）
我按下按钮然后运行一个程序打开MyExcelFile并读取第2列第6行中的数据...然后用该数据替换替换此文本...
Is there an easy(-ish) way of doing the following :
1. Highlight some text in a Word document
2. Press a (custom) button
3a. Read data from a specific cell in an Excel sheet (the Excel file always has the same name, the Row is defined by the numeric characters of the Word document) and replace the highlighted data.
3b. Alternatively, rather than highlighting text in the Word document, it has unique text.
For example, I have a document open called WordDoc6.
There is text in there that says "Replace this text" (which can be highlighted)
I press a button & it runs a program that opens MyExcelFile & reads the data in Column 2, Row 6 ... then replaces "Replace this text" with that data ...
好的，因为没有人知道如何做到这一点，这是一种方法，以防万一其他人正在寻找类似的解决方案...希望它有帮助...
OK, as nobody here knows how to do this, here is a way of doing it in case anybody else is looking for a similar solution ... hope it helps ...
'Create a link to use Excel
If Tasks.Exists(Name:="Microsoft Excel") = False Then
Set xlApp = CreateObject("Excel.Application")
ElseIf Tasks.Exists(Name:="Microsoft Excel") = True Then
Set xlApp = GetObject(, "Excel.Application")
End If
'Ensure Excel is Visible & not Hidden
xlApp.Application.Visible = True
'Open the Excel File that you want to edit
xlApp.Workbooks.Open myFolderPath + "Manager Of The Month.xlsx"
'Define specific Cells in the Excel file & Select the first one
Dim myCell1 as String
Dim myCell2 as String
Dim myCell3 as String
myCell1 = "B" & mySession + 1
myCell2 = "C" & mySession + 1
myCell3 = "D" & mySession + 1
xlApp.Range(myCell1).Select
'Wait until the Cells you want filled in the Excel file have all been filled
Do
'nothing
Loop Until xlApp.Range(myCell1) > "" And xlApp.Range(myCell2) > "" And xlApp.Range(myCell3) > ""
'Replace the text "MOTMDIV1" with the data entered into the first Excel Cell
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "MOTMDIV1"
.Replacement.Text = xlApp.Range(myCell1).Value
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Complete the edit update in the Word document by actually making the change
Selection.Find.Execute Replace:=wdReplaceAll
'Replace the text "MOTMDIV2" with the data entered into the second Excel Cell
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "MOTMDIV2"
.Replacement.Text = xlApp.Range(myCell2).Value
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Complete the edit update in the Word document by actually making the change
Selection.Find.Execute Replace:=wdReplaceAll
'Replace the text "MOTMDIV3" with the data entered into the third Excel Cell
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "MOTMDIV3"
.Replacement.Text = xlApp.Range(myCell3).Value
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Complete the edit update in the Word document by actually making the change
Selection.Find.Execute Replace:=wdReplaceAll
'Save & Quit Excel
xlApp.ActiveWorkbook.Save
xlApp.Quit
Set xlApp = Nothing
这可以通过多种方式改进，包括如果你有很多Cell，使用一个循环，但它对我有用，因为它是个人程序，我很满意。
This can probably be improved upon in many ways, including using a loop if you have a lot of Cells, but it''s working for me and as it is a personal program I am happy with it.