excelToWord-vba

 1 Sub ExcelToWord() '  利用Word程序创建文本文件，运行时word不能为打开状态
 2 
 3     Dim WordApp As Object
 4 
 5     '搜索Dim Records As Integer, i As Integer
 6 
 7     Dim Region As String, SalesAmt As String, SalesNum As String, strTitle As String
 8 
 9   
10 
11     Set WordApp = CreateObject("Word.Application") '创建word对象
12 
13     Records = Application.CountA(Sheets("sheet2").Range("A:A")) 'A列非空数据个数
14 
15   
16 
17     WordApp.Documents.Add '新建文档
18  
19 
20     '写Title
21 
22         strTitle = Cells(1, 5)
23 
24         With WordApp.Selection
25 
26             .Font.Size = 28
27 
28             .ParagraphFormat.Alignment = 1  '左对齐0  居中1 右对齐2
29 
30             .Font.Bold = True
31 
32             .TypeText Text:=strTitle
33 
34             .TypeParagraph
35 
36         End With
37 
38           
39 
40     '写内容
41 
42     For i = 2 To Records + 1
43 
44         'Region = Data.Cells(i, 1).Value '将第一列某行的值赋值给变量
45 
46         Region = Cells(i, 1)
47 
48         'SalesNum = Data.Cells(i, 2).Value '获取该行B列数据
49 
50         SalesNum = Cells(i, 2)
51 
52         'SalesAmt = Data.Cells(i, 3).Value '获取该行C列数据
53 
54         SalesAmt = Cells(i, 3)
55 
56  
57         With WordApp.Selection
58 
59                   
60 
61                 .Font.Size = 14 '设置字体字号
62 
63                 .Font.Bold = True '字体粗
64 
65                 .ParagraphFormat.Alignment = 0 '设置对齐
66 
67                 .TypeText Text:=Region & vbTab & SalesNum
68 
69                ' .TypeParagraph
70 
71   
72 
73                 .Font.Size = 12 '设置字体
74 
75                 .ParagraphFormat.Alignment = 0 '设置对齐
76 
77                 .Font.Bold = False '字体不加粗
78 
79                 .TypeText Text:=vbTab & SalesAmt
80 
81                 .TypeParagraph '回车
82 
83                 .TypeParagraph '回车
84 
85                   
86         End With
87 
88     Next i
89 
90   
91     WordApp.ActiveDocument.SaveAs Filename:="AAA" '保存文件
92 
93     WordApp.Quit '退出程序
94 
95     Set WordApp = Nothing '清空
96 
97     MsgBox "文件保存在我的文档底下的AAA文件"
98 
99 End Sub

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

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

  1 Sub 联系的例子二()
  2 Dim wd
  3 Dim Arange
  4 Set wd = CreateObject("word.application") '利用标识符启动WOrd wd.Visible = True’显示Word
  5 wd.Documents.Open ("E:officeexcelExcelToWord.docx") '打开欲操作的对像
  6 Arange = wd.Documents(1).Paragraphs(2).Range '取得要使用的文字
  7 Workbooks("第三节.xlsm").Worksheets(1).Range("b8") = Arange '将文字写入相应单元格 Set wd = Nothing '终止两个程序间的联系
  8 Set wd = Nothing '终止两个程序间的联系
  9 End Sub
 10 
 11 Sub ExcelToWord() '  利用Word程序创建文本文件，运行时word不能为打开状态
 12 
 13     Dim WordApp As Object
 14 
 15     '搜索Dim Records As Integer, i As Integer
 16 
 17     Dim Region As String, SalesAmt As String, SalesNum As String, strTitle As String
 18 
 19   
 20 
 21     Set WordApp = CreateObject("Word.Application") '创建word对象
 22 
 23     Records = Application.CountA(Sheets("sheet1").Range("A:A")) 'A列非空数据个数
 24 
 25   
 26 
 27     WordApp.Documents.Add '新建文档
 28  
 29 
 30     '写Title
 31 
 32         strTitle = Cells(1, 5)
 33 
 34         With WordApp.Selection
 35 
 36             .Font.Size = 28
 37 
 38             .ParagraphFormat.Alignment = 1  '左对齐0  居中1 右对齐2
 39 
 40             .Font.Bold = True
 41 
 42             .TypeText Text:=strTitle
 43 
 44             .TypeParagraph
 45 
 46         End With
 47 
 48           
 49 
 50     '写内容
 51 
 52     For i = 2 To Records + 1
 53 
 54         'Region = Data.Cells(i, 1).Value '将第一列某行的值赋值给变量
 55 
 56         Region = Cells(i, 1)
 57 
 58         'SalesNum = Data.Cells(i, 2).Value '获取该行B列数据
 59 
 60         SalesNum = Cells(i, 2)
 61 
 62         'SalesAmt = Data.Cells(i, 3).Value '获取该行C列数据
 63 
 64         SalesAmt = Cells(i, 3)
 65 
 66  
 67         With WordApp.Selection
 68 
 69                   
 70 
 71                 .Font.Size = 14 '设置字体字号
 72 
 73                 .Font.Bold = True '字体粗
 74 
 75                 .ParagraphFormat.Alignment = 0 '设置对齐
 76 
 77                 .TypeText Text:=Region & vbTab & SalesNum
 78 
 79                ' .TypeParagraph
 80 
 81   
 82 
 83                 .Font.Size = 12 '设置字体
 84 
 85                 .ParagraphFormat.Alignment = 0 '设置对齐
 86 
 87                 .Font.Bold = False '字体不加粗
 88 
 89                 .TypeText Text:=vbTab & SalesAmt
 90 
 91                 .TypeParagraph '回车
 92 
 93                 .TypeParagraph '回车
 94 
 95                   
 96         End With
 97 
 98     Next i
 99 
100   
101     WordApp.ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & "第三节" '按指定路径保存文件，此处为本excel路径
102 
103     WordApp.Quit '退出程序
104 
105     Set WordApp = Nothing '清空
106 
107     MsgBox "文件保存在" & ThisWorkbook.Path & "下 第三节 文件"
108 
109 End Sub

View Code