2021-09-18

最新推荐文章于 2024-06-25 18:03:54 发布

原创最新推荐文章于 2024-06-25 18:03:54 发布 · 104 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#vba

VBA 同时被 2 个专栏收录

2 篇文章

订阅专栏

批量生成word

1 篇文章

订阅专栏

电子表的VBA批量生成word文档

批量生成学生word成绩单，自动填写姓名，各科成绩，及评语。

Private Sub CommandButton1_Click()
  Dim wdapp As Object
  Dim myRange As Object
  '从工作表学生信息第2行到51行，51行是最后一个学生，如果学生多50多或60多
  For i = 2 To 51
  Set wdapp = CreateObject("word.application")
  wdapp.Visible = True
  wdapp.Documents.Open (ThisWorkbook.Path & "\moban.docx") '打开模板
  wdapp.Documents(1).SaveAs (ThisWorkbook.Path & "\成绩单\" + Sheet2.Cells(i, 2) + ".docx") '另为为模板
  '写入成绩
  With wdapp.Documents(1).tables(1).Range
       .Cells(17).Range = Sheet2.Cells(i, 4) '语
       .Cells(18).Range = Sheet2.Cells(i, 5) '数
       .Cells(19).Range = Sheet2.Cells(i, 6) '英
       .Cells(20).Range = Sheet2.Cells(i, 7) '物
       .Cells(21).Range = Sheet2.Cells(i, 8) '化
       
     ' .Cells(22).Range = Sheet2.Cells(i, 6) '政
     ' .Cells(23).Range = Sheet2.Cells(i, 7) '史
     ' .Cells(24).Range = Sheet2.Cells(i, 8) '地
       
       .Cells(25).Range = Sheet2.Cells(i, 9) '生
       .Cells(29).Range = Sheet2.Cells(i, 3) '总
       .Cells(30).Range = Sheet2.Cells(i, 10) '等第
       .Cells(32).Range = Sheet2.Cells(i, 11) '评语
    
  End With
  '替换姓名 hi 为学生= 姓名 家长
  '参数有点多是因为需要设替换很多条件
  wdapp.ActiveWindow.Selection.Find.ClearFormatting
       wdapp.ActiveWindow.Selection.Find.Replacement.ClearFormatting
       With wdapp.ActiveWindow.Selection.Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Forward = True
          .Execute FindText:="hi", ReplaceWith:=Sheet2.Cells(i, 2) '学生姓名
      End With
  wdapp.Documents(1).Save '保存
  wdapp.Quit '退出
  
  Set wdapp = Nothing
   Next
End Sub