●★将Excel数据写入Word模板★●

热浪2006

原帖由 ndt3 于 2009-11-9 11:53 发表

什么问题?

热浪2006

回复网友问题:

ndt3

感谢您的帮助！

热浪2006

简化了复制续表代码:

1. Private Sub CommandButton转换为Word表格_Click()
   
2.    Dim Word对象 As New Word.Application, 当前路径, 导出文件名, 导出路径文件名, 最后行号, i, j, 页数, Word续表行号
   
3.    当前路径 = ThisWorkbook.Path
   
4. 
   
5.    FileCopy 当前路径 & "\射线检测报告(模板).doc", Sheets("第1页").Range("X2") & "" & Sheets("第1页").Range("J2") & ".doc"
   
6.    导出路径文件名 = Sheets("第1页").Range("X2") & "" & Sheets("第1页").Range("J2") & ".doc"
   
7.    
   
8.    最后行号 = Sheets("第2页").Range("A65536").End(xlUp).Row
   
9.    If (最后行号 - 4) Mod 26 <> 0 Then
   
10.       页数 = (最后行号 - 4) \ 26 + 2
    
11.    Else
    
12.       页数 = (最后行号 - 4) \ 26 + 1
    
13.    End If
    
14.    With Word对象
    
15.       .Documents.Open 导出路径文件名
    
16.       .Visible = False
    
17.       
    
18.       If 页数 > 2 Then '复制粘贴续页
    
19.          .Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2" '定位到第2页
    
20.          .Selection.EndKey Unit:=wdStory, Extend:=wdExtend
    
21.          .Selection.Copy '复制
    
22.          For i = 1 To 页数 - 2 '粘贴
    
23.             .Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
24.             .Selection.PasteAndFormat (wdPasteDefault)
    
25.             .Selection.TypeBackspace
    
26.             .Selection.EndKey Unit:=wdStory, Extend:=wdExtend
    
27.          Next i
    
28.       End If
    
29.    
    
30.       '第1页表格：Tables(1)
    
31.       .ActiveDocument.Tables(1).Cell(1, 2).Range = Sheets("第1页").Range("D2") '施工单位名称
    
32.       .ActiveDocument.Tables(1).Cell(1, 4).Range = Sheets("第1页").Range("J2") '报告编号
    
33.       .ActiveDocument.Tables(1).Cell(1, 5).Range = "第1页  共" & 页数 & "页" '页码
    
34.       .ActiveDocument.Tables(1).Cell(2, 2).Range = Sheets("第1页").Range("D3") '单位工程名称
    
35.       .ActiveDocument.Tables(1).Cell(2, 4).Range = Sheets("第1页").Range("S3") '工程编号
    
36.       .ActiveDocument.Tables(1).Cell(3, 2).Range = Sheets("第1页").Range("B4") '检测日期
    
37.       .ActiveDocument.Tables(1).Cell(3, 4).Range = Sheets("第1页").Range("L4") '桩号
    
38.       .ActiveDocument.Tables(1).Cell(3, 6).Range = Sheets("第1页").Range("V4") '规格
    
39.       .ActiveDocument.Tables(1).Cell(4, 2).Range = Sheets("第1页").Range("B5") '材质
    
40.       .ActiveDocument.Tables(1).Cell(4, 4).Range = Sheets("第1页").Range("L5") '设备名称型号
    
41.       .ActiveDocument.Tables(1).Cell(4, 6).Range = Sheets("第1页").Range("V5") '焦点尺寸
    
42.       .ActiveDocument.Tables(1).Cell(5, 2).Range = Sheets("第1页").Range("B6") '透照方式
    
43.       .ActiveDocument.Tables(1).Cell(6, 2).Range = Sheets("第1页").Range("B7") '源的种类
    
44.       .ActiveDocument.Tables(1).Cell(6, 4).Range = Sheets("第1页").Range("O7") '焦距
    
45.       .ActiveDocument.Tables(1).Cell(6, 6).Range = Sheets("第1页").Range("V7") '胶片型号
    
46.       .ActiveDocument.Tables(1).Cell(7, 2).Range = Sheets("第1页").Range("B8") '胶片尺寸
    
47.       .ActiveDocument.Tables(1).Cell(7, 4).Range = Sheets("第1页").Range("M8") '像质计型号
    
48.       .ActiveDocument.Tables(1).Cell(7, 6).Range = Sheets("第1页").Range("U8") '像质计位置
    
49.       .ActiveDocument.Tables(1).Cell(8, 1).Range = Sheets("第1页").Range("A9") '管电压
    
50.       .ActiveDocument.Tables(1).Cell(8, 2).Range = Sheets("第1页").Range("E9") '管电流
    
51.       .ActiveDocument.Tables(1).Cell(8, 3).Range = Sheets("第1页").Range("N9") '源强
    
52.       .ActiveDocument.Tables(1).Cell(8, 4).Range = Sheets("第1页").Range("T9") '曝光时间
    
53.       .ActiveDocument.Tables(1).Cell(9, 2).Range = Sheets("第1页").Range("C10") '胶片处理
    
54.       .ActiveDocument.Tables(1).Cell(9, 3).Range = Sheets("第1页").Range("K10") '显影时间
    
55.       .ActiveDocument.Tables(1).Cell(9, 4).Range = Sheets("第1页").Range("S10") '显影温度
    
56.       .ActiveDocument.Tables(1).Cell(10, 2).Range = Sheets("第1页").Range("C11") '增感屏
    
57.       .ActiveDocument.Tables(1).Cell(10, 4).Range = Sheets("第1页").Range("R11") '显影配方
    
58.       .ActiveDocument.Tables(1).Cell(11, 2).Range = Sheets("第1页").Range("D12") '底片黑度
    
59.       .ActiveDocument.Tables(1).Cell(11, 4).Range = Sheets("第1页").Range("R12") '标准级别
    
60.       .ActiveDocument.Tables(1).Cell(12, 2).Range = Sheets("第1页").Range("C13") '检测数量
    
61.       .ActiveDocument.Tables(1).Cell(12, 4).Range = Sheets("第1页").Range("L13") '返修数量
    
62.       .ActiveDocument.Tables(1).Cell(12, 6).Range = Sheets("第1页").Range("U13") '一次合格率
    
63.      
    
64.       For j = 2 To 页数 '第j页表格：Tables(j)
    
65.          .ActiveDocument.Tables(j).Cell(1, 2).Range = Sheets("第2页").Range("B2") '报告编号
    
66.          .ActiveDocument.Tables(j).Cell(1, 3).Range = "第" & j & "页  共" & 页数 & "页" '页码
    
67.          Word续表行号 = 3
    
68.          For i = (j - 2) * 26 + 5 To (j - 2) * 26 + 30  '最后行号
    
69.             .ActiveDocument.Tables(j).Cell(Word续表行号, 1).Range = Sheets("第2页").Range("A" & i) '焊口编号
    
70.             If Len(Sheets("第2页").Range("A" & i)) > 31 Then
    
71.                .ActiveDocument.Tables(j).Cell(Word续表行号, 1).Range.Font.Size = 7 '改变字号
    
72.             End If
    
73.             .ActiveDocument.Tables(j).Cell(Word续表行号, 2).Range = Sheets("第2页").Range("B" & i) '透照长度
    
74.             .ActiveDocument.Tables(j).Cell(Word续表行号, 3).Range = Sheets("第2页").Range("C" & i) '缺欠性质
    
75.             .ActiveDocument.Tables(j).Cell(Word续表行号, 4).Range = Sheets("第2页").Range("D" & i) '缺欠尺寸及当量
    
76.             .ActiveDocument.Tables(j).Cell(Word续表行号, 5).Range = Sheets("第2页").Range("E" & i) '缺欠位置
    
77.             .ActiveDocument.Tables(j).Cell(Word续表行号, 6).Range = Sheets("第2页").Range("F" & i) '评定结果
    
78.             .ActiveDocument.Tables(j).Cell(Word续表行号, 7).Range = Sheets("第2页").Range("G" & i) '备注
    
79.             If Len(Sheets("第2页").Range("G" & i)) > 4 Then
    
80.                .ActiveDocument.Tables(j).Cell(Word续表行号, 7).Range.Font.Size = 8 '改变字号
    
81.             End If
    
82.             Word续表行号 = Word续表行号 + 1
    
83.         Next i
    
84.      Next j
    
85.    End With
    
86.    Word对象.Documents.Save
    
87.    Word对象.Quit
    
88.    Set Word对象 = Nothing
    
89.    i = MsgBox("已转换为 " & 导出路径文件名 & " 文件！", 0 + 48 + 256 + 0, "提示：")
    
90. End Sub
    

复制代码

ndt3

搞定了！谢谢热浪大哥了！

hangye

出错了 请指教

tpriyeah

思路挺好，学习中

lyllc2002

形成公文处理(热浪回复)模板很好，但如能做成分发版，即每单位为一个单独文件，那就更好。

[ 本帖最后由 lyllc2002 于 2009-11-14 20:34 编辑 ]

江南飞龙

相关材料真是太好了,但是如果用到财务分析报告中能否使用，我看了很多财务分析软件也具有此项功能，但我只能用EXCEL做好相关分析，但不能生成文字材料，下一步我将继续学习该部份内容，以求用于实际。

chenming279

强悍,要珍藏一下