Word vba:把從excel拷貝來的文字粘貼到word中並進行排版(添加多級列表+添加目錄+設置標題副標題作者及段落樣式)

此代碼可能運行幾次才能成功

重啟一下電腦容易一次成功

Excel中的文字如下（A列和B列）

結果如下：

vba代碼如下：

Sub把從excel拷貝來的文字粘貼到word中並進行排版() '主程序,此代碼在word中執行

Dim a As Object '定義一個object型變量

Dim m, n, i As Long '定義3個long型整數變量

Set a = CreateObject("Excel.Application") ' 調用excel軟體

a.Visible = True 'excel軟體前臺可見

a.WorkBooks.Open FileName:="C:\Users\p503406\Desktop\根據excel中的文字一

鍵生成滿足格式要求的word文檔.xlsx" '打開excel文件《根據excel中的文字一鍵生成

滿足格式要求的word文檔(未完成).xls》

m = a.ActiveSheet.Rows.Count '數一下 excel當前工作表共有多少行(空白行和

非空白行都數)

n = a.ActiveSheet.Cells(m, 1).End(3).Row '數一下 excel當前工作表共有多少

行有內容

For i = 1 To n Step 1

a.ActiveSheet.Cells(i, 2).Copy '複製excel表格中i行2列單元格中的內容

Word.Application.Activate '激活word軟體

Word.Application.Selection.PasteAndFormat (wdFormatPlainText) '把

excel表格中i行2列單元格中的內容以純文本格式粘貼到word文檔中，每一個單元格中

的內容在word中變成一個段落

If a.ActiveSheet.Cells(i, 1).Value = "文章標題" Then '對於標題

Word.Application.Selection.Style = ActiveDocument.Styles("標題")

'選擇標題樣式

Word.Application.Selection.ParagraphFormat.Alignment =

wdAlignParagraphCenter '標題居中

ElseIf a.ActiveSheet.Cells(i, 1).Value = "文章副標題" Then '對於副標

題

Word.Application.Selection.Style = ActiveDocument.Styles("副標題

") '選擇副標題樣式

Word.Application.Selection.ParagraphFormat.Alignment =

wdAlignParagraphCenter '副標題居中

ElseIf a.ActiveSheet.Cells(i, 1).Value = "作者" Then '對於作者

Word.Application.Selection.Style = ActiveDocument.Styles("正文")

'選擇作者樣式

Word.Application.Selection.ParagraphFormat.Alignment =

wdAlignParagraphCenter '作者居中

ElseIf a.ActiveSheet.Cells(i, 1).Value = "段落" Then '對於段落

Word.Application.Selection.Style = ActiveDocument.Styles("正文")

'選擇段落樣式

End If

If a.ActiveSheet.Cells(i, 1).Value = "正文一級標題" Then '對於一級標

題的段落

Word.Application.Selection.Style = ActiveDocument.Styles("標題

1")

Call 可為文章任何一個段落添加多級列表 '調用名為「可為文章任何一

個段落添加多級列表」代碼為此標題增加一級列表符號

ElseIf a.ActiveSheet.Cells(i, 1).Value = "正文二級標題" Then

Word.Application.Selection.Style = ActiveDocument.Styles("標題

2")

Call 可為文章任何一個段落添加多級列表 '調用名為「可為文章任何一

個段落添加多級列表」代碼為此標題增加一級列表符號

ElseIf a.ActiveSheet.Cells(i, 1).Value = "正文三級標題" Then

Word.Application.Selection.Style = ActiveDocument.Styles("標題

3")

Call 可為文章任何一個段落添加多級列表 ''調用名為「可為文章任何一

個段落添加多級列表」代碼為此標題增加一級列表符號

End If

Selection.TypeParagraph '在word中第i個段落末尾換行

Selection.Range.ListFormat.RemoveNumbers

NumberType:=wdNumberParagraph '換行後產生的新段落前自動添加多級列表符號，將

多級列表符號刪除，為插入第i+1個段落或標題做準備

Next i

Word.Application.ActiveDocument.ApplyQuickStyleSet2 ("Word 2010") '

整個文檔的整體樣式採用「Word 2010」樣式

Call 選中一個段落並將光標移動到該段落第一個字符前 '本代碼是把光標移動到

摘要兩個字的前面

Call 在光標所在處插入目錄

Call 在光標所在處插入分隔符中的分節符在分節符中選則下一頁分節符

Set a = Nothing ' 釋放內存

End Sub

Sub 可為文章任何一個段落添加多級列表() '被主程序調用的程序

With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(1)

.NumberFormat = "%1."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(0.75)

.TabPosition = wdUndefined

.ResetOnHigher = 0

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(2)

.NumberFormat = "%1.%2."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(1)

.TabPosition = wdUndefined

.ResetOnHigher = 1

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(3)

.NumberFormat = "%1.%2.%3."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(1.25)

.TabPosition = wdUndefined

.ResetOnHigher = 2

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(4)

.NumberFormat = "%1.%2.%3.%4."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(1.5)

.TabPosition = wdUndefined

.ResetOnHigher = 3

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(5)

.NumberFormat = "%1.%2.%3.%4.%5."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(1.75)

.TabPosition = wdUndefined

.ResetOnHigher = 4

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(6)

.NumberFormat = "%1.%2.%3.%4.%5.%6."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(2)

.TabPosition = wdUndefined

.ResetOnHigher = 5

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(7)

.NumberFormat = "%1.%2.%3.%4.%5.%6.%7."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(2.25)

.TabPosition = wdUndefined

.ResetOnHigher = 6

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(8)

.NumberFormat = "%1.%2.%3.%4.%5.%6.%7.%8."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(2.5)

.TabPosition = wdUndefined

.ResetOnHigher = 7

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(9)

.NumberFormat = "%1.%2.%3.%4.%5.%6.%7.%8.%9."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(2.75)

.TabPosition = wdUndefined

.ResetOnHigher = 8

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).Name = ""

Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:=

_

ListGalleries(wdOutlineNumberGallery).ListTemplates(1), _

ContinuePreviousList:=True, ApplyTo:=wdListApplyToWholeList, _

DefaultListBehavior:=wdWord10ListBehavior

End Sub

Sub 選中一個段落並將光標移動到該段落第一個字符前() '被主程序調用的程序

Word.Application.ActiveDocument.Paragraphs(4).Range.Select

Word.Application.Selection.MoveLeft Unit:=wdCharacter, Count:=1

End Sub

Sub 在光標所在處插入目錄() ''被主程序調用的程序。本代碼是把光標移動到摘要兩

個字的前面，即第4段落的最前面

Word.Application.Templates( _

"C:\Users\p503406\AppData\Roaming\Microsoft\Document Building

Blocks\2052\14\Built-In Building Blocks.dotx" _

).BuildingBlockEntries("自動目錄 1").Insert Where:=Selection.Range,

RichText _

:=True

End Sub

Sub 在光標所在處插入分隔符中的分節符在分節符中選則下一頁分節符() '被主程序調

用的程序

Word.Application.Selection.InsertBreak Type:=wdSectionBreakNextPage

End Sub