●★将Excel数据写入Word模板★●

xiaomils · 发表于 2021-3-13 14:30

楼主你好有空看一下我的帖子，帮忙解决一下，谢谢！！
http://club.excelhome.net/forum.php?mod=viewthread&tid=1577924&extra=page%3D2&mobile=2

许昌追风 · 发表于 2021-3-28 21:31

太棒了，一定好好学学

78fengqu · 发表于 2021-3-30 15:18

谢谢楼主分享！

kmyr007 · 发表于 2021-4-12 18:34

强的，就是这个了，

z9bhd · 发表于 2021-4-12 21:12

TSGRH 发表于 2021-1-27 14:35
楼主，你好。能否帮我整整这个。多谢！

Sub lx() '笛声悠扬于2021、4、12
Dim ar, br(), i%, j%, k%, wdapp As Object, wd As Object, wd1 As Object
      ar = Sheet1.Range("a2:i" & Sheet1.Range("a2").End(xlDown).Row)
      ReDim br(1 To UBound(ar), 1 To UBound(ar, 2) + 8)
      Set wdapp = CreateObject("word.application")
      wdapp.Visible = True
      Set wd1 = wdapp.documents.Open(ThisWorkbook.Path & "\劳动合同书1.docx")
      For i = 1 To UBound(ar)
         br(i, 1) = ar(i, 6): br(i, 2) = ar(i, 1): br(i, 3) = ar(i, 3): br(i, 4) = ar(i, 4)
         br(i, 5) = Year(ar(i, 5)): br(i, 6) = Month(ar(i, 5)): br(i, 7) = Day(ar(i, 5))
         For j = 1 To 3
                  br(i, (j - 1) * 3 + 8) = Year(ar(i, j + 6))
                  br(i, (j - 1) * 3 + 9) = Month(ar(i, j + 6))
                  br(i, (j - 1) * 3 + 10) = Day(ar(i, j + 6))
         Next j
         wd1.Range.Copy
         Set wd = wdapp.documents.Add
         wd.Range.Paste
         For k = 1 To UBound(br, 2)
            wd.Activate
            With wd.Range
                  .Find.ClearFormatting
                  .Find.Highlight = True
                  .Find.Replacement.ClearFormatting
                  With .Find
                     .Text = ""
                     .Forward = True
                     .Wrap = wdFindContinue
                     .Format = True
                  End With
                  .Find.Execute
                  If .Find.Found = True Then
                     .Text = br(i, k)
                     .HighlightColorIndex = wdNoHighlight

                  End If
            End With
         Next k
         wd.SaveAs (ThisWorkbook.Path & "\" & br(i, 2) & ".docx")
         wd.Close
      Next i
      Set wdapp = Nothing
      Set wd = Nothing
      Set wd1 = Nothing
End Sub

z9bhd · 发表于 2021-4-12 21:15

TSGRH 发表于 2021-1-27 14:35
楼主，你好。能否帮我整整这个。多谢！

劳动合同书.zip (56.24 KB, 下载次数: 59)

TSGRH · 发表于 2021-4-14 08:32

多谢以上各位！

wdw102 · 发表于 2021-5-2 13:36

十年前研究的东西，十年后继续学习

pc3709252 · 发表于 2021-5-18 19:58

热浪老师，这个在页眉如果有LOGO图片，会把图片清理掉了，如何是好。

townyee · 发表于 2021-5-25 19:15

感谢楼主分享，学习了~~~·

		自动登录	找回密码
密码			免费注册

[原创] ●★将Excel数据写入Word模板★●