怎么用word vba，将excel单元格内容，替换word文档指定位置中的内容么 VBA可以将excel单元格内容，替换word文档指定位置中...
VBA\u53ef\u4ee5\u5c06excel\u5355\u5143\u683c\u5185\u5bb9\uff0c\u66ff\u6362word\u6587\u6863\u6307\u5b9a\u4f4d\u7f6e\u4e2d\u7684\u5185\u5bb9\u4e48\uff1f\u5f53\u7136\u53ef\u4ee5\uff0c\u6211\u4ee5\u524d\u5199\u7684\uff0c\u4f60\u53ef\u4ee5\u53c2\u8003\u4e00\u4e0b\uff1a
Private Sub CommandButton1_Click()
On Error Resume Next
Dim iRow As Integer, myPath As String
Dim wdApp As Word.Application, wdDoc As Word.Document, wdRange As Word.Range
Dim \u6536\u6587\u65e5\u671f As String, \u6807\u9898 As String, \u6765\u6587\u5355\u4f4d As String, \u6587\u53f7 As String, \u62df\u529e\u60c5\u51b5 As String
'--------------------------------------------------------------------------------------------------------
Label3.Caption = "\u5c01\u9762\u6b63\u5728\u751f\u6210\u4e2d..."
'--------------------------------------------------------------------------------------------------------
iRow = TextBox1.Text
'\u83b7\u53d6\u5f85\u586b\u5199\u4fe1\u606f
\u6765\u6587\u5355\u4f4d = Cells(iRow, 3).Text
\u6765\u6587\u5355\u4f4d = Replace(\u6765\u6587\u5355\u4f4d, Chr(10), "^p") '\u5c06excel\u4e2d\u7684\u6362\u884c\u66ff\u6362\u6210word\u4e2d\u7684\u6362\u884c
\u6587\u53f7 = Cells(iRow, 4).Text
\u6587\u53f7 = Replace(\u6587\u53f7, Chr(10), "^p") '\u5c06excel\u4e2d\u7684\u6362\u884c\u66ff\u6362\u6210word\u4e2d\u7684\u6362\u884c
\u6807\u9898 = Cells(iRow, 5).Text
\u6807\u9898 = Replace(\u6807\u9898, Chr(10), "^p") '\u5c06excel\u4e2d\u7684\u6362\u884c\u66ff\u6362\u6210word\u4e2d\u7684\u6362\u884c
\u6536\u6587\u65e5\u671f = CStr(Year(Now())) & Cells(iRow, 6).Text
\u62df\u529e\u60c5\u51b5 = TextBox2.Text
'--------------------------------------------------------------------------------------------------------
myPath = ThisWorkbook.Path & "\\u5c01\u9762\"
'\u6587\u4ef6\u82e5\u5df2\u6253\u5f00,\u5219\u5173\u95ed\u5df2\u6253\u5f00\u6587\u4ef6
For Each wdDoc In Documents
If InStr(1, wdDoc.Name, myPath & "(" & \u6536\u6587\u65e5\u671f & ")" & \u6807\u9898 & ".doc", 1) Then
wdDoc.Close savechanges:=wdDoNotSaveChanges
Exit For
End If
Next wdDoc
'--------------------------------------------------------------------------------------------------------
Set wdDoc = CreateObject(myPath & "\u7a7a\u767d\u6a21\u677f.doc") '\u6253\u5f00word
wdDoc.Activate
'--------------------------------------------------------------------------------------------------------
'\u586b\u5199\u6587\u6863
Set wdRange = wdDoc.Content '\u5c06word\u7684\u6587\u6863\u5185\u5bb9\u8d4b\u4e88wdrange
wdRange.Find.Execute FindText:="{\u6765\u6587\u5355\u4f4d}", ReplaceWith:=\u6765\u6587\u5355\u4f4d, Replace:=wdReplaceAll
wdRange.Find.Execute FindText:="{\u6587\u53f7}", ReplaceWith:=\u6587\u53f7, Replace:=wdReplaceAll
wdRange.Find.Execute FindText:="{\u6536\u6587\u65f6\u95f4}", ReplaceWith:=\u6536\u6587\u65e5\u671f, Replace:=wdReplaceAll
wdRange.Find.Execute FindText:="{\u5185\u5bb9\u6458\u8981}", ReplaceWith:=\u6807\u9898, Replace:=wdReplaceAll
wdRange.Find.Execute FindText:="{\u529e\u516c\u5ba4\u62df\u529e}", ReplaceWith:=\u62df\u529e\u60c5\u51b5, Replace:=wdReplaceAll
'--------------------------------------------------------------------------------------------------------
'\u6587\u6863\u53e6\u5b58\u4e3a
wdDoc.SaveAs Filename:=myPath & "(" & \u6536\u6587\u65e5\u671f & ")" & \u6807\u9898 & ".doc"
End Sub
\u5f53\u7136\u53ef\u4ee5\uff0c\u6211\u4ee5\u524d\u5199\u7684\uff0c\u4f60\u53ef\u4ee5\u53c2\u8003\u4e00\u4e0b\uff1a
Private Sub CommandButton1_Click()
On Error Resume Next
Dim iRow As Integer, myPath As String
Dim wdApp As Word.Application, wdDoc As Word.Document, wdRange As Word.Range
Dim \u6536\u6587\u65e5\u671f As String, \u6807\u9898 As String, \u6765\u6587\u5355\u4f4d As String, \u6587\u53f7 As String, \u62df\u529e\u60c5\u51b5 As String
'--------------------------------------------------------------------------------------------------------
Label3.Caption = "\u5c01\u9762\u6b63\u5728\u751f\u6210\u4e2d..."
'--------------------------------------------------------------------------------------------------------
iRow = TextBox1.Text
'\u83b7\u53d6\u5f85\u586b\u5199\u4fe1\u606f
\u6765\u6587\u5355\u4f4d = Cells(iRow, 3).Text
\u6765\u6587\u5355\u4f4d = Replace(\u6765\u6587\u5355\u4f4d, Chr(10), "^p") '\u5c06excel\u4e2d\u7684\u6362\u884c\u66ff\u6362\u6210word\u4e2d\u7684\u6362\u884c
\u6587\u53f7 = Cells(iRow, 4).Text
\u6587\u53f7 = Replace(\u6587\u53f7, Chr(10), "^p") '\u5c06excel\u4e2d\u7684\u6362\u884c\u66ff\u6362\u6210word\u4e2d\u7684\u6362\u884c
\u6807\u9898 = Cells(iRow, 5).Text
\u6807\u9898 = Replace(\u6807\u9898, Chr(10), "^p") '\u5c06excel\u4e2d\u7684\u6362\u884c\u66ff\u6362\u6210word\u4e2d\u7684\u6362\u884c
\u6536\u6587\u65e5\u671f = CStr(Year(Now())) & Cells(iRow, 6).Text
\u62df\u529e\u60c5\u51b5 = TextBox2.Text
'--------------------------------------------------------------------------------------------------------
myPath = ThisWorkbook.Path & "\\u5c01\u9762\"
'\u6587\u4ef6\u82e5\u5df2\u6253\u5f00,\u5219\u5173\u95ed\u5df2\u6253\u5f00\u6587\u4ef6
For Each wdDoc In Documents
If InStr(1, wdDoc.Name, myPath & "(" & \u6536\u6587\u65e5\u671f & ")" & \u6807\u9898 & ".doc", 1) Then
wdDoc.Close savechanges:=wdDoNotSaveChanges
Exit For
End If
Next wdDoc
'--------------------------------------------------------------------------------------------------------
Set wdDoc = CreateObject(myPath & "\u7a7a\u767d\u6a21\u677f.doc") '\u6253\u5f00word
wdDoc.Activate
'--------------------------------------------------------------------------------------------------------
'\u586b\u5199\u6587\u6863
Set wdRange = wdDoc.Content '\u5c06word\u7684\u6587\u6863\u5185\u5bb9\u8d4b\u4e88wdrange
wdRange.Find.Execute FindText:="{\u6765\u6587\u5355\u4f4d}", ReplaceWith:=\u6765\u6587\u5355\u4f4d, Replace:=wdReplaceAll
wdRange.Find.Execute FindText:="{\u6587\u53f7}", ReplaceWith:=\u6587\u53f7, Replace:=wdReplaceAll
wdRange.Find.Execute FindText:="{\u6536\u6587\u65f6\u95f4}", ReplaceWith:=\u6536\u6587\u65e5\u671f, Replace:=wdReplaceAll
wdRange.Find.Execute FindText:="{\u5185\u5bb9\u6458\u8981}", ReplaceWith:=\u6807\u9898, Replace:=wdReplaceAll
wdRange.Find.Execute FindText:="{\u529e\u516c\u5ba4\u62df\u529e}", ReplaceWith:=\u62df\u529e\u60c5\u51b5, Replace:=wdReplaceAll
'--------------------------------------------------------------------------------------------------------
'\u6587\u6863\u53e6\u5b58\u4e3a
wdDoc.SaveAs Filename:=myPath & "(" & \u6536\u6587\u65e5\u671f & ")" & \u6807\u9898 & ".doc"
End Sub
但是word有现成的邮件合并，何必这么麻烦呢！
建议用Word中的邮件合并功能，应该可以满足你的要求。
以链接的形式插入
可以在Excel里用VBA写到Word文档里
扩展阅读：免费word在线编辑手机版 ... vba编程必背50个程序 ... word vba 日期 ... vba读取word表格 ... word vba教程完整版pdf ... 未安装vba如何启用宏 ... wordvba编程电子书版 ... word vba关闭文档 ... word vba编程手册 ...
