守柔版主再次帮忙！！！！！

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
上次按你写的插入表格，可是现在这个表格制完了，要插入另一表格（在下一页中），但却不能把光标移到最后一页上进行另一个表的制作。

用的是

selection.endkey unit:=wdstory 

但是程序老是报错，没有对象，或是对象不能进行此操作等错误，请版主给一个完整的例子。谢谢了！

守柔

如下：

……

          End With
        End With
        .Content.InsertAfter Chr(13)    '插入空白段落
        '定义wdRange为文档结束位置前一个字符
        Set wdRange = .Range(.Content.End - 1, .Content.End - 1)
        '插入表格
        Set wdTable = .Tables.Add(Range:=wdRange, numrows:=35, numcolumns:=7)
    End With
    wdApp.Visible = True    '恢复可见以加快程序运行
End Sub

你在EXCEL程序中使用selection.endkey unit:=wdstory  当然会出错了，这是个WORD命令啊？

改成wdDoc.ActiveWindow.Selection.EndKey wdStory可以移动到文档最后，注意对象的界定。

wjtwjt127

十分感谢，以后可能还要麻烦你的！！