excel表中的数据写入word文档

cindy88sy

最近有需求“将excel表中的数据写入word文档”，无奈自己没有钱币下载，找了一圈VBA开源代码改了改，给有需求的人。

• 表格样式：
  

表格样式

• word样式：
  

Sub Macro1()'引用Microsoft Word 12.0 Object Library    Dim MyWord As New Word.Application    Dim arr, MyPath$, MyFile$, MyName$, i&    MyPath = ThisWorkbook.Path & "\"    MyFile = MyPath & "进货表.docx"    arr = [a1].CurrentRegion    With MyWord        .Visible = False        For i = 2 To UBound(arr) Step 2            MyName = MyPath & "进货表(" & arr(i, 10) & ").docx"            FileCopy MyFile, MyPath & "进货表(" & arr(i, 10) & ").docx"            .Documents.Open MyName             With .ActiveDocument.Tables(2)                .Cell(6, 2).Range.Text = Chr(13) & arr(i, 10) & Chr(13)                .Cell(12, 2).Range.Text = Chr(13) & Mid(arr(i, 2), 5, 2)                .Cell(12, 3).Range.Text = Chr(13) & Right(arr(i, 2), 2)                .Cell(12, 4).Range.Text = Chr(13) & Left(arr(i, 2), 4)                .Cell(12, 6).Range.Text = Chr(13) & Mid(arr(i + 1, 2), 5, 2)                .Cell(12, 7).Range.Text = Chr(13) & Right(arr(i + 1, 2), 2)                .Cell(12, 8).Range.Text = Chr(13) & Left(arr(i + 1, 2), 4)                .Cell(15, 1).Range.Text = arr(i, 2) & " " & arr(i, 3) & arr(i, 4) & " " & arr(i, 5) & " " & arr(i, 6) & " 到"                .Cell(16, 1).Range.Text = arr(i + 1, 2) & " " & arr(i + 1, 3) & arr(i + 1, 4) & " " & arr(i + 1, 5) & " " & arr(i + 1, 6)             End With            .ActiveDocument.Close True        Next        .Quit    End With    Set MyWord = Nothing    MsgBox "ok"End Sub

2632692689

感谢，感谢

lwp72495lwp

咋玩呢？教程呢

hxp.china.sh

谁有在EXCEL里面生成二维码的VBA，可选择区域来批量生成的

Qq123333123

谢谢楼主分享，吾爱有你更精彩

pllpl

牛啊这东西                              

1e3e

晕，你这代码啊，好歹排一下版

叫我小王叔叔

这个看起来会好一点么？

[Asm] 纯文本查看 复制代码

Sub Macro1()'引用Microsoft Word 12.0 Object Library    Dim MyWord As New Word.Application    Dim arr, MyPath$, MyFile$, MyName$, i&    MyPath = ThisWorkbook.Path & "\"    MyFile = MyPath & "进货表.docx"    arr = [a1].CurrentRegion    With MyWord        .Visible = False        For i = 2 To UBound(arr) Step 2            MyName = MyPath & "进货表(" & arr(i, 10) & ").docx"            FileCopy MyFile, MyPath & "进货表(" & arr(i, 10) & ").docx"            .Documents.Open MyName             With .ActiveDocument.Tables(2)                .Cell(6, 2).Range.Text = Chr(13) & arr(i, 10) & Chr(13)                .Cell(12, 2).Range.Text = Chr(13) & Mid(arr(i, 2), 5, 2)                .Cell(12, 3).Range.Text = Chr(13) & Right(arr(i, 2), 2)                .Cell(12, 4).Range.Text = Chr(13) & Left(arr(i, 2), 4)                .Cell(12, 6).Range.Text = Chr(13) & Mid(arr(i + 1, 2), 5, 2)                .Cell(12, 7).Range.Text = Chr(13) & Right(arr(i + 1, 2), 2)                .Cell(12, 8).Range.Text = Chr(13) & Left(arr(i + 1, 2), 4)                .Cell(15, 1).Range.Text = arr(i, 2) & " " & arr(i, 3) & arr(i, 4) & " " & arr(i, 5) & " " & arr(i, 6) & " 到"                .Cell(16, 1).Range.Text = arr(i + 1, 2) & " " & arr(i + 1, 3) & arr(i + 1, 4) & " " & arr(i + 1, 5) & " " & arr(i + 1, 6)             End With            .ActiveDocument.Close True        Next        .Quit    End With    Set MyWord = Nothing    MsgBox "ok"End Sub

红蓝黄

代码太乱了

xiaoshu1688

VBA用好了就是顺手。