vba讲excel转换为word

VBA将excel转换为word

Sub ExportToWordFormatted()

    ' 声明变量
    Dim ws As Worksheet ' 用于存储当前活动的工作表
    Dim rng As Range ' 用于存储工作表的使用范围（即所有有数据的单元格）
    Dim rowCount As Long, colCount As Long ' 用于存储数据范围的行数和列数
    Dim i As Long, j As Long ' 用于循环遍历行和列
    
    Dim wordApp As Object ' 用于存储 Word 应用程序对象
    Dim wordDoc As Object ' 用于存储 Word 文档对象
    
    ' 设置工作表和数据范围
    Set ws = ActiveSheet ' 将当前活动的工作表赋值给变量 ws
    Set rng = ws.UsedRange ' 获取工作表中所有有数据的单元格范围，赋值给 rng
    
    rowCount = rng.Rows.Count ' 获取数据范围的行数
    colCount = rng.Columns.Count ' 获取数据范围的列数
    
    ' 启动 Word 应用程序
    On Error Resume Next ' 忽略错误，以便在 Word 未安装或未运行时避免报错
    Set wordApp = GetObject(Class:="Word.Application") ' 尝试获取已运行的 Word 应用程序实例
    If wordApp Is Nothing Then ' 如果未找到运行的实例
        Set wordApp = CreateObject(Class:="Word.Application") ' 创建一个新的 Word 应用程序实例
    End If
    On Error GoTo 0 ' 恢复正常的错误处理
    
    wordApp.Visible = True ' 设置 Word 应用程序为可见
    Set wordDoc = wordApp.Documents.Add ' 创建一个新的 Word 文档
    
    ' 遍历 Excel 中的每一行（从第2行开始，假设第1行为标题）
    For i = 2 To rowCount
        For j = 1 To colCount
            Dim title As String ' 用于存储当前列的标题
            Dim content As String ' 用于存储当前单元格的内容
            title = rng.Cells(1, j).Text ' 获取当前列的标题（第1行的内容）
            content = rng.Cells(i, j).Text ' 获取当前单元格的内容（第 i 行的内容）
            
            ' 将标题和内容格式化后插入到 Word 文档中
            wordDoc.content.InsertAfter Text:=i - 1 & "." & j & " " & title & "：" & content & vbCrLf
        Next j
        wordDoc.content.InsertAfter Text:=vbCrLf ' 每条记录后加一个空行
    Next i

    ' 提示用户数据已成功导出
    MsgBox "数据已成功导出到 Word！"

End Sub