vba 將excel 表複製到word（VBA基礎入門）

2023-05-31 16:55:44 2

截止目前寫了這些課程了：

[VBA][基礎入門] 第1講 常量和變量

[VBA][基礎入門] 第2講 錄製宏

[VBA][基礎入門] 第3講 認識VBA IDE（集成開發環境）

[VBA][基礎入門] 第4講 對象模型

不知道大家是不是按照我的講課順序在認真看和學。

上面只有兩個有連結，是因為不敢違反頭條的連結使用規則。

下面接著上一節的講，儘量緊扣上一節的內容，正確這一節課來個醍醐灌頂。

一、先教你們怎麼看內置對象模型

先嘗試看Ｗord的：

這裡需要用到，也會是你們以後使用VBA常用的部分

Alt F11，F1，F2

對於初學者，看對象模型的起點是從Application開始看，先把Application當做頂級對象。

先在F1裡輸入：Application 對象

裡面Application對象下的所有成員分成了三類：

方法、屬性、事件

先過一下，大概了解有哪些成員，對於一眼看去就特別實用，或者你比較感興趣的方法，就點進去看一眼再返回來。重點是能儘快建立對象樹。

如下是我現整理出來的Documents下的對象樹，包含大部分內容，加粗標註為很常用的對象。

Application

----Documents

--------Range

--------Shapes

--------Bookmarks

--------Characters

--------Comments

--------ContentControls

--------Endnotes

--------Fields

--------Footnotes

--------FormFields

--------Frames

--------Hyperlinks

--------Indexes

--------Inlineshapes

--------Lists

--------OMaths

--------Paragraphs

--------Revisions

--------Sections

--------Sentences

--------Shapes

--------StoryRanges

--------Styles

--------Subdocuments

--------Tables

--------TableOfContents

--------Variables

--------Windows

--------Words

我認為所有這些對象裡，吃透Range對象，就能玩轉WordVBA。

下節課再講Word.Range對象

二、然後再教怎麼在不同程序間交互

兩個文件分別是模板.doc、資料.xlsm

在Word裡讀取Excel：

Enum eIndex 工號 = 1 姓名 = 2 生日 = 3 籍貫 = 4 從業年份 = 5 入職日期 = 6End EnumSub ReadWorkBookDim wdDoc As Word.Document '為什麼這麼聲明，我想我以前講過Dim wdRng As Word.RangeDim xlApp As Excel.Application '為什麼這麼聲明，我想我以前講過Dim xlBook As Excel.WorkbookDim xlSht As Excel.WorksheetDim xlRng As Excel.RangeDim maxRow As LongDim arrDim U& '這個你能回憶起來嗎，雖然我不建議你們用Dim i&Set wdDoc = ThisDocumentOn Error GoTo getError '如果發生錯誤，就去到getError標籤Set xlApp = GetObject(, "Excel.Application") '獲取當前打開的Excel程序，如果報錯，就會去到getError標籤那裡GoTo NextStepgetError: Set xlApp = CreateObject("Excel.Application") '如當前沒有打開的Excel程序，則新建一個 xlApp.Visible = True '調試用，調試完了，可以改成FalseNextStep:On Error Goto 0 '不處理其他錯誤Set xlBook = xlApp.Workbooks.Open(wdDoc.Path & "\資料.xlsm", , True) '打開工作簿Set xlSht = xlBook.Worksheets("資料") '獲取工作表maxRow = xlSht.Range("A" & xlSht.Rows.Count).End(xlUp).Row '獲取最後的非空列號，相當於在A1048576，按Ctrl ↑Set xlRng = xlSht.Range("A2:F" & maxRow) '獲取目標區域arr = xlRngxlBook.Close False 'Excel的任務完成了，關閉且不保存U = UBound(arr, 1)Application.ScreenUpdating = False '關閉當前Word程序屏幕刷新，極大提供效率For i = 1 To U '循環，寫數據到Word的表格1中 With wdDoc.Tables(1) Set wdRng = .Cell(1, 1).Range wdRng.SetRange wdRng.End - 4, wdRng.End - 1 wdRng.Text = arr(i, eIndex.工號) .Cell(2, 2).Range.Text = arr(i, eIndex.姓名) .Cell(3, 2).Range.Text = arr(i, eIndex.生日) .Cell(3, 4).Range.Text = arr(i, eIndex.籍貫) .Cell(4, 2).Range.Text = arr(i, eIndex.從業年份) .Cell(4, 4).Range.Text = arr(i, eIndex.入職日期) If Application.Version >= 14 Then 'Word2010及以上 .Parent.SaveAs2 wdDoc.Path & "\" & arr(i, 工號) & "_" & arr(i, 姓名) & ".doc" Else .Parent.SaveAs wdDoc.Path & "\" & arr(i, 工號) & "_" & arr(i, 姓名) & ".doc" End If End WithNext iApplication.ScreenUpdating = TrueEnd Sub

再看從Excel裡生成Word：

Enum eIndex 工號 = 1 姓名 = 2 生日 = 3 籍貫 = 4 從業年份 = 5 入職日期 = 6End EnumSub WriteDocumentDim wdApp As Word.ApplicationDim wdDoc As Word.DocumentDim wdRng As Word.RangeDim xlBook As WorkbookDim xlSht As WorksheetDim xlRng As Excel.RangeDim maxRow As LongDim arrDim U&Dim i&Set xlBook = ThisWorkbookSet xlSht = xlBook.Worksheets("資料")maxRow = xlSht.Range("A" & xlSht.Rows.Count).End(xlUp).RowSet xlRng = xlSht.Range("A2:F" & maxRow)arr = xlRngU = UBound(arr, 1)On Error GoTo getErrorSet wdApp = GetObject(, "Word.Application") '當前如有Word程序，直接調用GoTo NextStepgetError: Set wdApp = CreateObject("Word.Application") '如沒有，則新建NextStep: wdApp.ScreenUpdating = FalseFor i = 1 To U With wdApp.Documents.Open(xlBook.Path & "\模板.doc") '打開Word模板 With .Tables(1) '往word文檔的表格1裡寫數據 Set wdRng = .Cell(1, 1).Range wdRng.SetRange wdRng.End - 4, wdRng.End - 1 wdRng.Text = arr(i, eIndex.工號) .Cell(2, 2).Range.Text = arr(i, eIndex.姓名) .Cell(3, 2).Range.Text = arr(i, eIndex.生日) .Cell(3, 4).Range.Text = arr(i, eIndex.籍貫) .Cell(4, 2).Range.Text = arr(i, eIndex.從業年份) .Cell(4, 4).Range.Text = arr(i, eIndex.入職日期) End With If wdApp.Version >= 14 Then 'Word2010及以上 .SaveAs2 xlBook.Path & "\" & arr(i, 工號) & "_" & arr(i, 姓名) & ".doc" Else .SaveAs xlBook.Path & "\" & arr(i, 工號) & "_" & arr(i, 姓名) & ".doc" End If .Close True End WithNext iEnd Sub

請大家好好分析一下這兩段代碼，力求全部吃透。

不能吃透的內容本文評論下留言，我會以天為單位統一回復。