標題:
[發問]
關於利用vba將excel資料傳入word
[打印本頁]
作者:
kuu
時間:
2016-4-5 05:20
標題:
關於利用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
作者:
GBKEE
時間:
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
複製代碼
作者:
kuu
時間:
2016-4-6 20:57
回復
2#
GBKEE
感謝GBKEE前輩的說明
不過,我需要將EXCEL的某些欄位,帶至WORD位置
可能EXCEL的A1欄位資料(今天的日期),需要帶至WORD第一頁的第一欄的某文字後面出現,如測試日期:→帶出2016/04/06
EXCEL的B2欄位資料(物品名稱),需帶至WORD第一頁,第五欄的某文物後面出現:如物品名稱:→ABC
EXCEL的C5欄位資料(完成日期),需帶至WORD第二頁,第一欄的某文字後面出現,如完成日期:→帶出2016/04/06
並非將EXCLE資料表,貼到WORD的資料表
不知前輩是否能幫忙修改
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)