党组织关系转移介绍信

欧陈养

gwjkkkkk 发表于 2024-5-25 11:54
文件发上来，看一下，模拟一下结果，应该可能解决。。。

就是你发的那个附件啊

gwjkkkkk

欧陈养 发表于 2024-5-25 11:56
就是你发的那个附件啊

统发什么意思 ，没看懂。。。

欧陈养

生成一个文档

欧陈养

你那个附件，生成一个文档

zhumin1025

批量填表范畴https://club.excelhome.net/forum.php?mod=viewthread&tid=1692108&extra=page%3D1&mobile=2&_dsign=bee2ca91

gwjkkkkk

欧陈养 发表于 2024-5-25 12:29
你那个附件，生成一个文档

Option Explicit

Sub TEST3()
    Dim wdApp As Word.Application, strFileName$, strPath$
    Dim ar, i&, j&, strSaveName$, Rng As Word.Range
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "党组织关系介绍信样式.doc"
    If Dir(strFileName) = "" Then MsgBox "模板.docx文件不存在，请检查！", vbExclamation: Exit Sub
   
    Application.ScreenUpdating = False
    ar = [A1].CurrentRegion.Value
   
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err <> 0 Then
        Set wdApp = New Word.Application
    End If
   
    With wdApp.Documents.Add
         strSaveName = strPath & "汇总"
         For i = 2 To UBound(ar)
         With wdApp.Documents.Open(strFileName)

                 For j = 1 To UBound(ar, 2)
                    With .Content.Find
                       .Text = "数据" & Format(j + 1, "000")
                       If j = 4 Then ar(i, j) = Mid(ar(i, j), 1, Len(ar(i, j)) - 1)
                       .Replacement.Text = ar(i, j)
                       .Execute Replace:=wdReplaceAll
                    End With
                 Next j
                 With .Content.Find
                      .Text = "数据001"
                      .Replacement.Text = 10000 + i - 1
                      .Execute Replace:=wdReplaceAll
                 End With
                 With .Content.Find
                     .ClearFormatting
                     .Text = "男/女"
                     .Forward = True
                     Do While .Execute
                         With .Parent
                             If ar(i, 2) = "男" Then
                                 Set Rng = wdApp.ActiveDocument.Range(.Start + 2, .End)
                             Else
                                 Set Rng = wdApp.ActiveDocument.Range(.Start, .Start + 1)
                             End If
                         End With
                         Rng.Font.Strikethrough = True
                     Loop
                 End With
                 With .Content.Find
                     .ClearFormatting
                     .Text = "预备/正式"
                     .Forward = True
                     Do While .Execute
                         With .Parent
                             If Mid(ar(i, 5), 1, 2) = "正式" Then
                                 Set Rng = wdApp.ActiveDocument.Range(.Start, .Start + 2)
                             Else
                                 Set Rng = wdApp.ActiveDocument.Range(.Start + 3, .End)
                             End If
                         End With
                         Rng.Font.Strikethrough = True
                     Loop
                 End With
                 .Range(0, .Content.End - 1).Copy
                 .Close False
             End With
             If i <> 2 Then wdApp.Selection.InsertBreak (7)
             wdApp.Selection.Paste
         Next i
         .SaveAs strSaveName: .Close
     End With
   
    If Err <> 0 Then wdApp.Quit
    Set wdApp = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

欧陈养 发表于 2024-5-25 12:29
你那个附件，生成一个文档

。。。。。。。。。。。

sby250

我通常是把WORD转换成excel表格后在引用数据 。

huarong7984

gwjkkkkk 发表于 2024-5-23 21:48
请参考附件。。。。

gwjkkkkk大师：您好。
    我下载的您的代码，并在原始工作表中增加一些列，并修改了模板，但运行后，出现以下问题：
      1、年龄只显示1位数，即显示十位上的数，个位上的数没显示。
      2、吴春英是正式党员，但导入Word后，变为预备党员了
      3、党费交到日期、开出组织关系日期，导入Word后，日期都带了星期
           不知哪出了问题，敬请大师指教，并修改，谢谢大师！

gwjkkkkk

huarong7984 发表于 2024-5-25 16:35
gwjkkkkk大师：您好。
    我下载的您的代码，并在原始工作表中增加一些列，并修改了模板，但运行后，出 ...

第1.2是定位的问题，因为需要取部分字段，所以进行判断
第3.点我这里的没问题，我不知道什么情况。