将Excel数据写入Word模板（有文本框）

cqcbc

将Excel数据写入Word模板（有文本框）中的对应位置，然后分别保存，附件中的代码，可以处理不是文本框中的替换，请老师们参考，或者重写，谢谢。

shenjianrong163

邮件合并就可以处理了。

cqlpjxx

建议：修改模板，去掉文本框。

386026398

直接转为word不是更好吗

欧陈养

应该可以实现的

cqcbc

欧陈养 发表于 2025-1-10 11:49
应该可以实现的

请帮忙写一下，谢谢。

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim mypath$, myname$
   
5.     Dim wordapp As Object
   
6.     Dim mydoc As Object
   
7.     Dim flg As Boolean
   
8.     vs = [{"<学生>",2;"<班主任>",12}]
   
9.     If Dir(ThisWorkbook.Path & "\通知书(模板).doc") = "" Then
   
10.         MsgBox ThisWorkbook.Path & "\通知书(模板).doc不存在！"
    
11.         Exit Sub
    
12.     End If
    
13. 
    
14.     With Worksheets("数据")
    
15.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
16.         arr = .Range("a2:l" & r)
    
17.     End With
    
18.     On Error Resume Next
    
19.     Set wordapp = GetObject(, "word.application")
    
20.     If Err Then
    
21.         flg = True
    
22.         Set wordapp = CreateObject("word.application")
    
23.     End If
    
24.     On Error GoTo 0
    
25.     wordapp.Visible = True
    
26.     If Dir(ThisWorkbook.Path & "\通知书", vbDirectory) = "" Then
    
27.         MkDir ThisWorkbook.Path & "\通知书"
    
28.     End If
    
29.     For i = 1 To UBound(arr)
    
30.         FileCopy ThisWorkbook.Path & "\通知书(模板).doc", ThisWorkbook.Path & "\通知书" & arr(i, 11) & "_" & arr(i, 2) & ".doc"
    
31.         Set mydoc = wordapp.Documents.Open(Filename:=ThisWorkbook.Path & "\通知书" & arr(i, 11) & "_" & arr(i, 2) & ".doc")
    
32.         With mydoc
    
33.             .Activate
    
34.             With .Shapes(1).TextFrame.TextRange
    
35.                 With .Find
    
36.                     .ClearFormatting
    
37.                     .Replacement.ClearFormatting
    
38.                     For k = 1 To UBound(vs)
    
39.                         .Text = vs(k, 1)
    
40.                         .Replacement.Text = arr(i, vs(k, 2))
    
41.                         .Execute Replace:=2, Forward:=True, Wrap:=1
    
42.                     Next
    
43.                 End With
    
44.                 With .Tables(1)
    
45.                     For j = 3 To 9
    
46.                         .Cell(2, j - 1).Range.Text = arr(i, j)
    
47.                     Next
    
48.                     .Cell(3, 2).Range.Text = arr(i, 10)
    
49.                     With .Cell(3, 2).Range.ParagraphFormat
    
50.                         .CharacterUnitFirstLineIndent = 2
    
51.                     End With
    
52.                 End With
    
53.             End With
    
54.             .Close True
    
55.         End With
    
56.     Next
    
57.     If flg Then
    
58.         wordapp.Quit
    
59.     End If
    
60. End Sub
    

复制代码

chxw68

最近刚好学习WORD VBA.

cqcbc

chxw68 发表于 2025-1-10 15:48
最近刚好学习WORD VBA.

谢谢老师，太厉害了。佩服！！我始终去针对文本框，不是Characters 属性出现“错误的参数”问题，就是其它的错误......

cqcbc

欧陈养 发表于 2025-1-10 11:49
应该可以实现的

感谢帮助，已收到文件，测试了，完美。