[發問] 關於利用vba將excel資料傳入word

各位好：我因為有需要，上網查了此功能
但當初寫的只有二筆資料key(1)' key(2)
而我的需要可能超過10筆資料需要透過vba將excel資料傳入word，不知要如何更改
請前輩能夠協助說明

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False  '關閉屏幕刷新
On Error Resume Next '捕捉錯誤
Dim oSt As Range, wdDoc As Word.Document, wdRange As Word.Range
myPath = ThisWorkbook.Path & "\2.doc" '定義word文件路徑,名字自己修改,我設定為2.doc
Set wdDoc = GetObject(myPath) '打開word
Dim key(2)       '定義一下數組,
key(1) = "Applicant :" '要替換的數据
key(2) = "Assignment No :"
   Set wdRange = wdDoc.Content  '將word的文檔內容賦予wdrange
For i = 1 To 2    '循環
      With wdRange.Find
         .Text = key(i)          '查找
         .Replacement.Text = key(i) + IIf(i = 1, Cells(1, 2).Value, Cells(2, 2).Value)  '替換
         .Forward = True
         .Wrap = wdFindContinue
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchByte = True
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
      End With
      wdRange.Find.Execute Replace:=wdReplaceAll          '全部替換?

Next
wdDoc.Save    '保存word
wdDoc.Close '關閉word
Set wdDoc = Nothing
Application.ScreenUpdating = True '開啟屏幕刷新

End Sub

樓主熱帖

kuu

小學生 Rank: 1

帖子: 13
主題: 3
精華: 0
積分: 16
點名: 0
作業系統: WINXP
軟體版本: OFFICE2003
閱讀權限: 10
性別: 男
註冊時間: 2010-8-9
最後登錄: 2024-9-1

3^#

發表於 2016-4-6 20:57 | 只看該作者

[版主管理留言]

GBKEE(2016/4/7 06:25): 附檔說明看看

回復 2# GBKEE
感謝GBKEE前輩的說明
不過，我需要將EXCEL的某些欄位，帶至WORD位置
可能EXCEL的A1欄位資料(今天的日期)，需要帶至WORD第一頁的第一欄的某文字後面出現，如測試日期：→帶出2016/04/06
EXCEL的B2欄位資料(物品名稱)，需帶至WORD第一頁，第五欄的某文物後面出現：如物品名稱：→ABC
EXCEL的C5欄位資料(完成日期)，需帶至WORD第二頁，第一欄的某文字後面出現，如完成日期：→帶出2016/04/06

並非將EXCLE資料表，貼到WORD的資料表

不知前輩是否能幫忙修改

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2016-4-6 09:53 | 只看該作者

回復 1# kuu
試試看

Option Explicit
Sub Ex()
Dim xWord As Object, myRange As Object, E As Range ', key(1 To 2)
Set xWord = CreateObject("Word.Application") ' Word 程式
With xWord
.Visible = True
.DOCUMENTS.Open (ThisWorkbook.Path & "\2.doc") '開啟檔案
Set myRange = .ActiveDocument.Content '檔案文件本文
End With
' key(1) = "Applicant :"
' key(2) = "Assignment No :"
' For Each E In key ''要替換的數据在陣列 '-> 修改為 E As Variant
For Each E In [a1:a4] ' 要替換的數据在工作表
myRange.Find.Execute FindText:=E.Text, MatchWholeWord:=True, ReplaceWith:=E & E.Row, Replace:=2 'wdReplaceAll
Next
myRange.Parent.Save '存檔
xWord.Quit '關閉Word 程式
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP