如何用vba把excel表转换成word表，附件上传，守柔请帮忙

wjtwjt127

如何用vba把excel表转换成word表，请高手给个例子。谢谢了,附件已上传

就是这样的两个一横一竖的表格 zLl6JVbW.rar (14.04 KB, 下载次数: 70)

2006-12-5 11:16 上传

点击文件名下载附件
如何用vba把excel表转换成word表

[此贴子已经被作者于2006-12-5 11:39:57编辑过]

守柔

QUOTE:

以下是引用wjtwjt127在2006-12-4 11:53:48的发言：

如何用vba把excel表转换成word表，请高手给个例子。谢谢了

请楼主给你例子，你想把EXCEL中的什么样的表，转换成WORD中什么样形式的表，只要两个附件就行了。

谢谢。

守柔

你的WORD的结果呢？

可以使用复制粘贴吗？

wjtwjt127

不用复制粘贴的给个例子，最好版式也是排好的

守柔

以下代码供参考：

Option Explicit

Sub ExcelToWord()
'运行本代码前必须确认在EXCEL VBE中勾选对于"Microsoft Word 11.0(OFFICE版本) Object Library的引用
    Dim wdApp As Word.Application, wdDoc As Word.Document, wdRange As Word.Range
    Dim wdTable As Word.Table, byteCol As Byte, ColWidths As Variant
    Dim xlSheet As Excel.Worksheet, xlRange As Excel.Range, i As Excel.Range
    On Error Resume Next
    Set xlSheet = ActiveWorkbook.Worksheets("总概算")
    Set xlRange = xlSheet.Range("B3:H35")
    '取得对Word应用程序的引用
    Set wdApp = GetObject(, "Word.Application")
    '如果没有打开的Word,则创建
    If Err.Number <> 0 Then Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True '调试用,正式中写入False
    Set wdDoc = wdApp.Documents.Add '新建空白文档
    With wdDoc
        Set wdRange = .Range(0, 0)
        '创建一个指定行列数的表格
        Set wdTable = .Tables.Add(Range:=wdRange, numrows:=35, numcolumns:=7)
        With wdTable
        '为单元格赋值,可根据情况对EXCEL单元格中的数据进行取整或者小数点保留
            For Each i In xlRange
                .Cell(i.Row, i.Column - 1).Range.Text = i.Value
            Next
            ColWidths = Array(0.5, 7, 2, 2, 2, 2, 2) '预定义列宽
            For byteCol = 1 To 7 '设置列宽
                .Columns(byteCol).PreferredWidthType = wdPreferredWidthPoints
                .Columns(byteCol).PreferredWidth = CentimetersToPoints(ColWidths(byteCol - 1) * 1)
            Next
            .Rows.Alignment = wdAlignRowCenter '表格居中
            '单元格中部居中
            .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
            '设置表格格式
            .Range.Font.Size = 11
            .Range.Font.Name = "仿宋_GB2312"
            '对第一行合并并录入文本设置格式
            With .Rows(1)
                .Cells.Merge
                .Range.Text = "总估算表"
                .Range.Font.Name = "黑体"
                .Range.Font.Size = 16
            End With
            '对第二行进行合并并录入文本设置格式
            With .Rows(2)
                .Cells(7).Merge .Cells(6)
                .Cells(6).Range.Text = "单元：万元"
                .Cells(2).Merge .Cells(1)
                .Cells(1).Range.Text = "表12-1-1"
                .Cells(2).Merge .Cells(4)
                .Range.Font.Size = 12
            End With
            '设置重复的标题行
            Set wdRange = .Range
            wdRange.SetRange wdRange.Start, .Rows(3).Range.End
            wdRange.Rows.HeadingFormat = True
            Set wdRange = .Range
            '设置表格边框线
            With wdRange
                .SetRange .Rows(3).Range.Start, .End
                With .Rows
                .Borders.OutsideLineStyle = wdLineStyleSingle
                .Borders.OutsideLineWidth = wdLineWidth050pt
                .Borders.InsideLineStyle = wdLineStyleSingle
                .Borders.InsideLineWidth = wdLineWidth050pt
                End With
            End With
        End With
    End With
    wdApp.Visible = True '恢复可见以加快程序运行
End Sub