求助：功能为EXCEL转word

18117590891

求助，本功能为excel转WORD, 但试了半天通不过，求大神帮忙调试。



Sub ExportExcelToWord()
    ' 选择 Excel 文件
    Dim strFilePath As String
    strFilePath = Application.GetOpenFilename("Excel 文件 (*.xls*), *.xls*", , "选择要导出的 Excel 文件")
    If strFilePath = "" Then
        MsgBox "未选择任何文件", vbExclamation, "提示"
        Exit Sub
    End If
   
    ' 打开 Excel 文件
    Dim objExcel As Object
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False ' 不显示 Excel 窗口
    objExcel.Workbooks.Open strFilePath
   
    ' 复制所有表格
    Dim objWorkbook As Object
    Set objWorkbook = objExcel.ActiveWorkbook
    Dim objWorksheet As Object
    Dim objRange As Object
    Dim objTable As Object
    For Each objWorksheet In objWorkbook.Worksheets
        objWorksheet.Activate
        For Each objRange In objWorksheet.UsedRange.SpecialCells(xlCellTypeVisible)
            If objRange.Rows.Count > 1 Or objRange.Columns.Count > 1 Then
                Set objTable = objExcel.Selection.ConvertToTable(Separator:=vbTab)
                objTable.Range.Copy
                Dim objWord As Object
                Set objWord = CreateObject("Word.Application")
                objWord.Visible = True ' 可见性，可选
                Dim objDoc As Object
                Set objDoc = objWord.Documents.Add
                objWord.Selection.PasteExcelTable False, False, False ' 将表格粘贴到 Word 中
                objWord.Selection.TypeParagraph ' 换行
                objWord.Selection.TypeParagraph ' 换行
            End If
        Next objRange
    Next objWorksheet
   
    ' 保存 Word 文件
    Dim strSavePath As String
    strSavePath = Application.GetSaveAsFilename("导出 Word 文件", "Word 文件 (*.docx), *.docx")
    If strSavePath = "" Then
        MsgBox "未选择保存路径", vbExclamation, "提示"
        Exit Sub
    End If
   
    Debug.Print TypeName(objExcel)
If objExcel Is Nothing Then
    MsgBox "objExcel 没有被正确赋值", vbExclamation, "错误"
    Exit Sub
End If

     objWord.ActiveDocument.SaveAs2 strSavePath
   
    ' 关闭 Excel 和 Word
    objWorkbook.Close False
    objExcel.Quit
    objDoc.Close False
    objWord.Quit
    Set objExcel = Nothing
    Set objWord = Nothing
   
    MsgBox "导出成功", vbInformation, "提示"
End Sub

xyxcc177

不用代码，将EXCEL另存为HTML网页，再用WORD打开网页文件。