网站 › 『编程语言讨论求助区』 › excel表中的数据写入word文档

cindy88sy 发表于 2021-11-18 11:05

excel表中的数据写入word文档

最近有需求“将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 = .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 发表于 2021-11-18 12:32

感谢，感谢

lwp72495lwp 发表于 2021-11-18 12:34

咋玩呢？教程呢

hxp.china.sh 发表于 2021-11-18 12:53

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

Qq123333123 发表于 2021-11-18 12:59

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

pllpl 发表于 2021-11-18 13:01

牛啊这东西                              

1e3e 发表于 2021-11-18 13:14

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

叫我小王叔叔 发表于 2021-11-18 13:19

这个看起来会好一点么？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 = .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

红蓝黄 发表于 2021-11-18 13:43

代码太乱了

xiaoshu1688 发表于 2021-11-18 13:45

VBA用好了就是顺手。

查看完整版本: excel表中的数据写入word文档