excelToWord-vba

提示：扫一扫查出行
【扫一扫了解最新限行尾号】
复制提示

 Sub ExcelToWord() '  利用Word程序创建文本文件，运行时word不能为打开状态

     Dim WordApp As Object

     '搜索Dim Records As Integer, i As Integer

     Dim Region As String, SalesAmt As String, SalesNum As String, strTitle As String

     Set WordApp = CreateObject("Word.Application") '创建word对象

     Records = Application.CountA(Sheets("sheet2").Range("A:A")) 'A列非空数据个数

     WordApp.Documents.Add '新建文档

     '写Title

         strTitle = Cells(, )

         With WordApp.Selection

             .Font.Size = 

             .ParagraphFormat.Alignment =   '左对齐0  居中1 右对齐2

             .Font.Bold = True

             .TypeText Text:=strTitle

             .TypeParagraph

         End With

     '写内容

     For i =  To Records + 

         'Region = Data.Cells(i, 1).Value '将第一列某行的值赋值给变量

         Region = Cells(i, )

         'SalesNum = Data.Cells(i, 2).Value '获取该行B列数据

         SalesNum = Cells(i, )

         'SalesAmt = Data.Cells(i, 3).Value '获取该行C列数据

         SalesAmt = Cells(i, )

         With WordApp.Selection

                 .Font.Size =  '设置字体字号

                 .Font.Bold = True '字体粗

                 .ParagraphFormat.Alignment =  '设置对齐

                 .TypeText Text:=Region & vbTab & SalesNum

                ' .TypeParagraph

                 .Font.Size =  '设置字体

                 .ParagraphFormat.Alignment =  '设置对齐

                 .Font.Bold = False '字体不加粗

                 .TypeText Text:=vbTab & SalesAmt

                 .TypeParagraph '回车

                 .TypeParagraph '回车

         End With

     Next i

     WordApp.ActiveDocument.SaveAs Filename:="AAA" '保存文件

     WordApp.Quit '退出程序

     Set WordApp = Nothing '清空

     MsgBox "文件保存在我的文档底下的AAA文件"

 End Sub

注意代码和数据源都在sheet2中。

若要改变保存word的路径（参考：http://club.excelhome.net/thread-1301171-1-1.html）：

 Sub 联系的例子二()

 Dim wd

 Dim Arange

 Set wd = CreateObject("word.application") '利用标识符启动WOrd wd.Visible = True’显示Word

 wd.Documents.Open ("E:\office\excel\ExcelToWord.docx") '打开欲操作的对像

 Arange = wd.Documents().Paragraphs().Range '取得要使用的文字

 Workbooks("第三节.xlsm").Worksheets().Range("b8") = Arange '将文字写入相应单元格 Set wd = Nothing '终止两个程序间的联系

 Set wd = Nothing '终止两个程序间的联系

 End Sub

 Sub ExcelToWord() '  利用Word程序创建文本文件，运行时word不能为打开状态

     Dim WordApp As Object

     '搜索Dim Records As Integer, i As Integer

     Dim Region As String, SalesAmt As String, SalesNum As String, strTitle As String

     Set WordApp = CreateObject("Word.Application") '创建word对象

     Records = Application.CountA(Sheets("sheet1").Range("A:A")) 'A列非空数据个数

     WordApp.Documents.Add '新建文档

     '写Title

         strTitle = Cells(, )

         With WordApp.Selection

             .Font.Size = 

             .ParagraphFormat.Alignment =   '左对齐0  居中1 右对齐2

             .Font.Bold = True

             .TypeText Text:=strTitle

             .TypeParagraph

         End With

     '写内容

     For i =  To Records + 

         'Region = Data.Cells(i, 1).Value '将第一列某行的值赋值给变量

         Region = Cells(i, )

         'SalesNum = Data.Cells(i, 2).Value '获取该行B列数据

         SalesNum = Cells(i, )

         'SalesAmt = Data.Cells(i, 3).Value '获取该行C列数据

         SalesAmt = Cells(i, )

         With WordApp.Selection

                 .Font.Size =  '设置字体字号

                 .Font.Bold = True '字体粗

                 .ParagraphFormat.Alignment =  '设置对齐

                 .TypeText Text:=Region & vbTab & SalesNum

                ' .TypeParagraph

                 .Font.Size =  '设置字体

                 .ParagraphFormat.Alignment =  '设置对齐

                 .Font.Bold = False '字体不加粗

                 .TypeText Text:=vbTab & SalesAmt

                 .TypeParagraph '回车

                 .TypeParagraph '回车

         End With

     Next i

     WordApp.ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & "\第三节" '按指定路径保存文件，此处为本excel路径

     WordApp.Quit '退出程序

     Set WordApp = Nothing '清空

     MsgBox "文件保存在" & ThisWorkbook.Path & "下 第三节 文件"

 End Sub