iT邦幫忙

0

EXCEL利用VBA程式輸出數值到WORD

#excel #vba
et05262000 2023-12-15 13:41:59 ‧ 1068 瀏覽

  • 分享至 

  • xImage

請問各位高手們，我想利用EXCEL的VBA程式輸出數值到WORD制式的表格，表格如下，希望EXCEL表格裡的AAA.BBB.CCC.DDD.EEE裡的數值可以利用程式帶入到WORD相對應表格中，再麻煩各位高手們，幫忙指教一下，謝謝。
https://truth.bahamut.com.tw/s01/202312/e1335ae5b1f4cc5c7c7cfed03c6767b0.JPG
https://truth.bahamut.com.tw/s01/202312/9b5d6374d035e5baa317d89bc796d338.JPG
Sub 將數值套用到Word表格()
' 宣告 Word.Application 和 Word.Document 對象
Dim wordApp As Object
Dim wordDoc As Object

' 嘗試獲取現有的 Word.Application 實例
On Error Resume Next
Set wordApp = GetObject(, "Word.Application")
On Error GoTo 0

' 如果 Word.Application 實例不存在，則創建一個新實例
If wordApp Is Nothing Then
    Set wordApp = CreateObject("Word.Application")
End If

' 打開 Word 文件
wordApp.Visible = True
Set wordDoc = wordApp.Documents.Open("C:\Users\USER\Desktop\EXCEL轉WORD用(XXX).docx") ' 替換為你的 Word 文件路徑

' 將 Excel 數值套用到 Word 表格中的第一個表格
Dim excelSheet As Worksheet
Set excelSheet = ThisWorkbook.Sheets("工作表1") ' 替換為你的 Excel 工作表名稱

' 從 Excel 中獲取數值
Dim valueToApply As Variant
valueToApply = excelSheet.Range("A3").Value
wordDoc.Tables(1).Cell(5, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C3").Value
wordDoc.Tables(1).Cell(5, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D3").Value
wordDoc.Tables(1).Cell(5, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E3").Value
wordDoc.Tables(1).Cell(5, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A5").Value
wordDoc.Tables(1).Cell(6, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C5").Value
wordDoc.Tables(1).Cell(6, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D5").Value
wordDoc.Tables(1).Cell(6, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E5").Value
wordDoc.Tables(1).Cell(6, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A7").Value
wordDoc.Tables(1).Cell(7, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C7").Value
wordDoc.Tables(1).Cell(7, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D7").Value
wordDoc.Tables(1).Cell(7, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E7").Value
wordDoc.Tables(1).Cell(7, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A9").Value
wordDoc.Tables(1).Cell(8, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C9").Value
wordDoc.Tables(1).Cell(8, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D9").Value
wordDoc.Tables(1).Cell(8, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E9").Value
wordDoc.Tables(1).Cell(8, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A11").Value
wordDoc.Tables(1).Cell(9, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C11").Value
wordDoc.Tables(1).Cell(9, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D11").Value
wordDoc.Tables(1).Cell(9, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E11").Value
wordDoc.Tables(1).Cell(9, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A13").Value
wordDoc.Tables(1).Cell(10, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C13").Value
wordDoc.Tables(1).Cell(10, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D13").Value
wordDoc.Tables(1).Cell(10, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E13").Value
wordDoc.Tables(1).Cell(10, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A15").Value
wordDoc.Tables(1).Cell(11, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C15").Value
wordDoc.Tables(1).Cell(11, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D15").Value
wordDoc.Tables(1).Cell(11, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E15").Value
wordDoc.Tables(1).Cell(11, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A17").Value
wordDoc.Tables(1).Cell(12, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C17").Value
wordDoc.Tables(1).Cell(12, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D17").Value
wordDoc.Tables(1).Cell(12, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E17").Value
wordDoc.Tables(1).Cell(12, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A19").Value
wordDoc.Tables(1).Cell(13, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C19").Value
wordDoc.Tables(1).Cell(13, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D19").Value
wordDoc.Tables(1).Cell(13, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E19").Value
wordDoc.Tables(1).Cell(13, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A21").Value
wordDoc.Tables(1).Cell(14, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C21").Value
wordDoc.Tables(1).Cell(14, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D21").Value
wordDoc.Tables(1).Cell(14, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E21").Value
wordDoc.Tables(1).Cell(14, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A23").Value
wordDoc.Tables(1).Cell(15, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C23").Value
wordDoc.Tables(1).Cell(15, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D23").Value
wordDoc.Tables(1).Cell(15, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E23").Value
wordDoc.Tables(1).Cell(15, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A25").Value
wordDoc.Tables(1).Cell(16, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C25").Value
wordDoc.Tables(1).Cell(16, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D25").Value
wordDoc.Tables(1).Cell(16, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E25").Value
wordDoc.Tables(1).Cell(16, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A27").Value
wordDoc.Tables(1).Cell(17, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C27").Value
wordDoc.Tables(1).Cell(17, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D27").Value
wordDoc.Tables(1).Cell(17, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E27").Value
wordDoc.Tables(1).Cell(17, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A29").Value
wordDoc.Tables(1).Cell(18, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C29").Value
wordDoc.Tables(1).Cell(18, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D29").Value
wordDoc.Tables(1).Cell(18, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E29").Value
wordDoc.Tables(1).Cell(18, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A31").Value
wordDoc.Tables(1).Cell(19, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C31").Value
wordDoc.Tables(1).Cell(19, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D31").Value
wordDoc.Tables(1).Cell(19, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E31").Value
wordDoc.Tables(1).Cell(19, 5).Range.Text = valueToApply
valueToApply = excelSheet.Range("A33").Value
wordDoc.Tables(1).Cell(24, 1).Range.Text = valueToApply
valueToApply = excelSheet.Range("C33").Value
wordDoc.Tables(1).Cell(24, 3).Range.Text = valueToApply
valueToApply = excelSheet.Range("D13").Value
wordDoc.Tables(1).Cell(24, 4).Range.Text = valueToApply
valueToApply = excelSheet.Range("E33").Value
wordDoc.Tables(1).Cell(24, 5).Range.Text = valueToApply

Set wordApp = Nothing

End Sub

我有試著寫了，以上是我的程式碼，我的表格只有15行，但數據有17行，我不知道要怎麼寫可以跳到下一頁指定的格子，請教各位高手幫幫忙

亂皮皮 iT邦新手 2 級 ‧ 2023-12-15 14:04:17 檢舉
用合併列印比較快吧! 但為什麼要從EXCEL表放到WORD去呢!
et05262000 iT邦新手 5 級 ‧ 2023-12-15 17:40:57 檢舉
我試過了，但數值會跑掉，所以才會想用VBA試看看，因為資料很多，會打很久，所以才會有這個想法，謝謝
登入發表討論
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

2 個回答

1
海綿寶寶
iT邦大神 1 級 ‧ 2023-12-15 19:50:56

參考這篇看看可不可用

登入發表回應
0
rain_yu
iT邦新手 1 級 ‧ 2023-12-18 08:33:21

我個人會建議你直接在excel做同樣格式輸出，會比把資料弄到word後再輸出穩定。
你這版面excel也可以做得到並輸出。
用VBA還要測，不太符合成本。
下面是初步的VBA寫法，沒做過細節驗證，
要用VBA的話你要自行研究；

Sub ExportToWord()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim xlSheet As Worksheet
    Dim xlRange As Range
    Dim i As Integer
    
    ' 開啟Word應用程式
    Set wdApp = CreateObject("Word.Application")
    
    ' 開啟Word文件
    Set wdDoc = wdApp.Documents.Open("C:\Path\To\Your\Word\File.docx") ' 替換為您的Word文件路徑
    
    ' 設定Excel工作表
    Set xlSheet = ThisWorkbook.Sheets("Sheet1") ' 替換為您的Excel工作表名稱
    
    ' 設定Excel欄位範圍
    Set xlRange = xlSheet.Range("A1:C10") ' 替換為您的Excel欄位範圍
    
    ' 迴圈遍歷Excel欄位範圍
    For i = 1 To xlRange.Rows.Count
        ' 將Excel值複製到Word文件中的對應位置
        wdDoc.ContentControls(i).Range.Text = xlRange.Cells(i, 1).Value ' 替換為您的Word文件中的對應位置
        
        ' 如果有多個欄位，可以使用類似的方式複製值到對應的位置
        ' wdDoc.ContentControls(2).Range.Text = xlRange.Cells(i, 2).Value
        ' wdDoc.ContentControls(3).Range.Text = xlRange.Cells(i, 3).Value
    Next i
    
    ' 保存Word文件
    wdDoc.Save
    
    ' 關閉Word文件
    wdDoc.Close
    
    ' 關閉Word應用程式
    wdApp.Quit
    
    ' 釋放物件
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set xlRange = Nothing
    Set xlSheet = Nothing
    
    MsgBox "匯入完成！"
End Sub

需要根據您的實際情況進行以下修改：

替換"C:\Path\To\Your\Word\File.docx"為您的Word文件的路徑。
替換"Sheet1"為您的Excel工作表名稱。
替換"A1:C10"為您要匯入的Excel欄位範圍。
根據您的Word文件中的對應位置，修改wdDoc.ContentControls(i).Range.Text的索引及對應的Excel欄位索引。
執行此VBA程式碼後，它將打開Word文件並將Excel欄位的值匯入到相應的Word列印格式中。完成後，會顯示一個訊息框顯示匯入完成。

請確保在執行前儲存Excel文件。同時，請注意確保您的Word文件中有相應的內容控制項(Content Control)來接收Excel值。

看更多先前的回應...收起先前的回應...
et05262000 iT邦新手 5 級 ‧ 2023-12-21 17:19:02 檢舉

我有試了可以，但如果超過行數，無法自行換到下一頁，不知道有沒有解

rain_yu iT邦新手 1 級 ‧ 2023-12-22 08:23:51 檢舉

有圖案嗎?

et05262000 iT邦新手 5 級 ‧ 2023-12-22 09:18:25 檢舉

我上面寫的程式碼就只能一頁，需要加入什麼才可以程式語言才可以有換下一頁的功能，現在try不出來，不知道高手有解嗎?

rain_yu iT邦新手 1 級 ‧ 2023-12-26 08:40:47 檢舉

抱歉，這幾天很忙，你用這個試試看

Sub 匯入資料到WORD表格()
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim excelSheet As Worksheet
    Dim dataRange As Range
    Dim rowCount As Integer
    Dim currentPage As Integer
    Dim totalPages As Integer
    Dim i As Integer
    
    ' 開啟WORD應用程式
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True
    
    ' 開啟WORD文件
    Set wordDoc = wordApp.Documents.Open("C:\Path\To\Your\Word\File.docx")
    
    ' 設定要匯入的資料範圍
    Set excelSheet = ThisWorkbook.Sheets("Sheet1") ' 假設資料在Sheet1上
    Set dataRange = excelSheet.Range("A2:C19") ' 假設資料範圍是A2:C19
    
    ' 計算總頁數
    rowCount = dataRange.Rows.Count
    totalPages = WorksheetFunction.Ceiling(rowCount / 15)
    
    ' 開始匯入資料
    currentPage = 1
    For i = 1 To rowCount Step 15
        ' 插入表格到WORD文件
        wordDoc.Range.InsertAfter "Page " & currentPage & vbCrLf
        wordDoc.Range.InsertParagraphAfter
        dataRange.Offset(i - 1).Resize(15).Copy
        wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
        
        ' 換頁
        If currentPage < totalPages Then
            wordDoc.Range.InsertBreak Type:=7 ' wdPageBreak
        End If
        
        currentPage = currentPage + 1
    Next i
    
    ' 關閉WORD文件
    wordDoc.Close SaveChanges:=True
    
    ' 關閉WORD應用程式
    wordApp.Quit
    
    ' 釋放物件
    Set wordDoc = Nothing
    Set wordApp = Nothing
    
    MsgBox "匯入完成！"
End Sub
rain_yu iT邦新手 1 級 ‧ 2023-12-26 08:41:33 檢舉

請注意，你需要將程式碼中的檔案路徑和資料範圍 (excelSheet 和 dataRange) 根據你的實際情況進行修改。此外，這個範例假設你的資料範圍是A2:C19，並且每頁表格有15筆資料。你可以根據需要調整這些值。

這段程式碼會在匯入15筆資料後插入分頁符號，以便在WORD文件中換頁。如果你的資料筆數不是15的倍數，最後一頁可能會少於15筆資料。你可以根據需要進行調整。

希望這可以幫助到你！如果有任何其他問題，請隨時提出。

rain_yu iT邦新手 1 級 ‧ 2023-12-28 14:19:41 檢舉

Sub 匯入資料到WORD表格()
Dim wordApp As Object
Dim wordDoc As Object
Dim excelSheet As Worksheet
Dim dataRange As Range
Dim rowCount As Integer
Dim currentPage As Integer
Dim i As Integer

' 開啟WORD應用程式
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True

' 開啟WORD文件
Set wordDoc = wordApp.Documents.Open("C:\Path\To\Your\Word\File.docx")

' 設定要匯入的資料範圍
Set excelSheet = ThisWorkbook.Sheets("Sheet1") ' 假設資料在Sheet1上
Set dataRange = excelSheet.Range("A2:C19") ' 假設資料範圍是A2:C19

' 開始匯入資料
currentPage = 1
For i = 1 To dataRange.Rows.Count
' 插入表格到WORD文件
wordDoc.Range.InsertAfter "Page " & currentPage & vbCrLf
wordDoc.Range.InsertParagraphAfter
dataRange.Rows(i).Copy
wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

' 換頁
If i Mod 15 = 0 Then
wordDoc.Range.InsertBreak Type:=7 ' wdPageBreak
currentPage = currentPage + 1
End If
Next i

' 關閉WORD文件
wordDoc.Close SaveChanges:=True

' 關閉WORD應用程式
wordApp.Quit

' 釋放物件
Set wordDoc = Nothing
Set wordApp = Nothing

MsgBox "匯入完成！"
End Sub
這段程式碼會將Excel的數據逐行插入到Word文件中的表格，並在每15行插入分頁符號。這樣可以確保多餘的數據會在新的頁面上顯示。請確保您的Word文件中已經有一個表格，並且該表格足夠大以容納您要插入的數據。

請注意，這段程式碼假設您的Excel數據範圍是固定的，從A2到C19。如果您的數據範圍不同，請修改dataRange的設定以符合您的需求。

登入發表回應

我要發表回答

立即登入回答
iThome鐵人賽
參賽組數
1123 組
團體組數
52 組
累計文章數
23096 篇
完賽人數
656 人
iT+看影片追技術 看影片追技術 看更多
熱門tag 看更多
15th鐵人賽 13th鐵人賽 14th鐵人賽 12th鐵人賽 11th鐵人賽 鐵人賽 2019鐵人賽 2018鐵人賽 javascript 2017鐵人賽 python windows php c# windows server linux css 程式設計 react vue.js
熱門問題
熱門回答
熱門文章
IT邦幫忙