把EXCEL數(shù)據(jù)寫入WORD文檔A

1、VBA在EXCEL中操作WORD表格之七 第 7 頁(yè) 共 7 頁(yè)把EXCEL工作表數(shù)據(jù)用VBA寫入WORD文檔編輯：madmlwt1逐個(gè)單元格數(shù)據(jù)寫入WORD表格【問題要求】新建“工程訂單.doc”，保存到當(dāng)前操作的EXCEL文件位置。新建“工程訂單.doc”文檔中，第一段落寫入“工程訂單”，第二段落寫入“單位：新建裝飾有限公司”，第三段落插入一個(gè)與當(dāng)前工作表中數(shù)據(jù)行列數(shù)完全相同的表格。把當(dāng)前工作表中數(shù)據(jù)(包括標(biāo)題行)按單元格讀取方式逐個(gè)寫入WORD表格中。格式設(shè)置第一段落黑體、18號(hào)、水平居中；第二段落宋體、14號(hào)、水平居中；表格在頁(yè)面中水平居中；表格數(shù)據(jù)宋體、10號(hào)、左對(duì)齊；標(biāo)題行加粗、水

2、平居中。【代碼】Sub EXCEL保存為WORD表格數(shù)據(jù)()Application.ScreenUpdating = False '關(guān)閉屏幕刷新開始時(shí)間 = Timer '程序運(yùn)行開始時(shí)間(秒)hs = ActiveSheet.UsedRange.Rows.Count '當(dāng)前工作表數(shù)據(jù)行數(shù)ls = ActiveSheet.UsedRange.Columns.Count '當(dāng)前工作表數(shù)據(jù)列數(shù)wjM = "工程訂單"myFile = ActiveWorkbook.Path & "" & wjM & &q

3、uot;.doc" '保存的文件及路徑On Error Resume Next '出現(xiàn)錯(cuò)誤跳到下一行Kill myFile '刪除文件On Error GoTo 0 '不進(jìn)行錯(cuò)誤處理Set wd = CreateObject("Word.Application") '定義一個(gè)Word對(duì)象變量With wd .Documents.Add '創(chuàng)建一個(gè)新的Word文檔 With .ActiveDocument.Paragraphs(1).Range '當(dāng)前活動(dòng)文檔中 .InsertParagraphBefore &

4、#39;在指定的所選內(nèi)容或區(qū)域前插入一個(gè)新段落 .InsertBefore "工程訂單" '寫入新段落內(nèi)容 .Font.Name = "黑體" '字體 .Font.Size = 18 '字號(hào) .ParagraphFormat.Alignment = 1 '水平居中 End With With .ActiveDocument.Paragraphs(2).Range .InsertAfter "單位：新建裝飾有限公司" .Font.Name = "華文新魏" .Font.Size = 1

5、4 .ParagraphFormat.Alignment = 1 End With .ActiveDocument.Paragraphs(2).Range.InsertParagraphAfter '在第二段后面插入一個(gè)新的段落 .ActiveDocument.Paragraphs(3).Range.Select '選中第三段落 .ActiveDocument.Tables.Add Range:=.Selection.Range, NumRows:=hs, NumColumns:=ls '插入hs行l(wèi)s列表格 With .ActiveDocument.Tables(1)

6、 'WORD表格 For h = 1 To hs '從第一行循環(huán)到hs行 For l = 1 To ls '從第1列循環(huán)到ls列 .Cell(h, l).Range = ActiveSheet.Cells(h, l) '把當(dāng)前工作表單元格數(shù)據(jù)寫入WORD表格 With .Cell(h, l).Range '單元格字體設(shè)置 .Font.Name = "宋體" '字體 .Font.Size = 10 '字號(hào) .Font.Bold = True '加粗 If h > 1 Then .Font.Bold = Fa

7、lse '如果表格行不是第一行則字形不加粗 End With Next l Next h End With .Selection.Tables(1).AutoFitBehavior (1) '根據(jù)內(nèi)容自動(dòng)調(diào)整表格 .Selection.Tables(1).Rows(1).HeadingFormat = 9999998 '標(biāo)題行重復(fù) .ActiveDocument.Tables(1).Rows.Alignment = 1 '表格水平居中 .Selection.Tables(1).Range.ParagraphFormat.Alignment = 3 '所有

8、行數(shù)據(jù)左對(duì)齊 .Selection.Tables(1).Rows(1).Range.ParagraphFormat.Alignment = 1 '標(biāo)題行居中 .ActiveDocument.SaveAs myFile '保存新建Word文檔 .Quit '關(guān)閉新建文檔窗口End WithSet wd = NothingMsgBox Chr(10) & "成功創(chuàng)建一個(gè)WORD表格" & wjM _ & Chr(10) & Chr(10) & "共用時(shí) " & Timer - 開始時(shí)間

9、& " 秒", , "Exc_To_Word"Application.ScreenUpdating = False '關(guān)閉屏幕刷新End Sub說明：逐個(gè)單元格數(shù)據(jù)寫入WORD表格，就是工作表中的數(shù)據(jù)單元格，對(duì)應(yīng)已經(jīng)創(chuàng)建的WORD表格單元格，逐個(gè)寫入數(shù)據(jù)，這是EXCEL數(shù)據(jù)保存為WORD表格最基本、常規(guī)的操作方法。把EXCEL數(shù)據(jù)保存為WORD表格數(shù)據(jù)，基本思路就是先寫入數(shù)據(jù)再設(shè)置格式。上面代碼在逐個(gè)單元格寫入數(shù)據(jù)過程中，對(duì)單元格進(jìn)行了字體格式設(shè)置，如果是龐大數(shù)據(jù)的寫入，可能會(huì)降低寫入速度。所以最好是把數(shù)據(jù)完全寫入后對(duì)表格整體進(jìn)行所有格式

10、設(shè)置。2當(dāng)前工作表數(shù)據(jù)復(fù)制到WORD文檔【問題要求】把被操作的EXCEL當(dāng)前工作表數(shù)據(jù)復(fù)制粘貼到新建的WORD文檔。新建WORD文檔“清單.doc”，與被操作的EXCEL文件保存在相同位置。新建WORD文檔格式： 第一段落為表格總標(biāo)題名“復(fù)制EXCEL數(shù)據(jù)粘貼到新建WORD文檔”、第二段落為作者或者單位名稱“作者：老頑童”、第三段落粘貼復(fù)制的EXCEL數(shù)據(jù)表格。 第一段落黑體、18號(hào)、加粗、居中。 第二段落華文新魏、14號(hào)、居中。 表格數(shù)據(jù)標(biāo)題行宋體、12號(hào)、加粗。 表格在頁(yè)面中水平居中、表格跨頁(yè)則標(biāo)題行重復(fù)、表格根據(jù)內(nèi)容自動(dòng)調(diào)整列寬?！敬a】Sub excel數(shù)據(jù)復(fù)制粘貼到word()App

11、lication.ScreenUpdating = False '關(guān)閉屏幕刷新qsT = Timer '開始時(shí)間ActiveSheet.UsedRange.Copy '復(fù)制已經(jīng)使用的數(shù)據(jù)區(qū)域wjM = "清單" '文件名稱myFile = ThisWorkbook.Path & "" & wjM & ".doc" '保存的文件及路徑On Error Resume Next '出現(xiàn)錯(cuò)誤跳到下一行Kill myFile '刪除文件On Error GoTo 0

12、 '不進(jìn)行錯(cuò)誤處理Set wd = CreateObject("word.application") '創(chuàng)建WORD對(duì)象wd.Documents.Add.SaveAs Filename:=myFile '新建一個(gè)WORD文件并保存With wd.ActiveDocument.Paragraphs(1).Range '當(dāng)前活動(dòng)文檔中第一段 .InsertParagraphBefore '左邊（或前）插入一個(gè)新段落 .InsertBefore "復(fù)制EXCEL數(shù)據(jù)粘貼到新建WORD文檔" '寫入新段落內(nèi)容End

13、 Withwd.ActiveDocument.Paragraphs(1).Range.InsertAfter "作者：老頑童" '第一段右邊插入新段落wd.ActiveDocument.Paragraphs(2).Range.InsertParagraphAfter '在第二段后面插入一個(gè)新的段落wd.ActiveDocument.Paragraphs(3).Range.Select '選中第三段落wd.Selection.PasteExcelTable False, True, False '粘貼復(fù)制的EXCEL表格With wd.Acti

14、veDocument.Paragraphs(1).Range '第一段文本格式設(shè)置 .ParagraphFormat.Alignment = 1 '水平居中 .Font.Size = 18 '字號(hào) .Font.Name = "黑體" '字體 .Font.Bold = True '加粗End WithWith wd.ActiveDocument.Paragraphs(2).Range '第二段文本格式設(shè)置 .ParagraphFormat.Alignment = 1 .Font.Size = 14 .Font.Name = &q

15、uot;華文新魏"End WithWith wd.Selection.Tables(1) .AutoFitBehavior (1) '根據(jù)內(nèi)容調(diào)整表格列寬 .Rows(1).HeadingFormat = 9999998 '標(biāo)題行重復(fù) .Rows.Alignment = 1 '表格水平居中 With .Rows(1).Range .Font.Size = 12 '字號(hào) .Font.Name = "宋體" '字體 .Font.Bold = True '加粗 End WithEnd Withwd.ActiveDocume

16、nt.Save '保存修改wd.ActiveDocument.Close '關(guān)閉文檔wd.Quit '關(guān)閉WORD程序Set myRange = Nothing '釋放內(nèi)存Set adoc = Nothing '釋放內(nèi)存Set wd = Nothing '釋放內(nèi)存Application.CutCopyMode = False '撤銷復(fù)制狀態(tài)MsgBox Chr(10) & "成功地把當(dāng)前EXCEL數(shù)據(jù)復(fù)制粘貼到WORD文檔" _ & Chr(10) & Chr(10) & "共計(jì)用去時(shí)間 " & Timer - qsT & " 秒", , "excel數(shù)據(jù)復(fù)制粘貼到word"Applicatio