用VBA按特定的条件插入空行，邮件合并打印准考证自动按班分开！

lc16whj

      制作了一个准考证的邮件合并，Word模板每张纸打印4张准考证，用邮件合并后的文件，所有的准考证都是相连的。
请高手用VBA或函数生成特定的空行，插入到Excel数据文件里面，实现Word模板邮件合并后，打印准考证时，不要手动分割纸张，自动按班分开。
特定的条件：在每个班级的后面插入一些空行，从而使每个班级的最后一个行号都为4的倍数+1(标题行)！
在VBA代码里面标注一下数字4，以便我可以更改这个数字，适合以后更改Word模板准考证的张数。
注意：VBA代码要支持增减行和列，因为实际使用的时候可能会增减行和列。
附件”邮件合并数据文件“的“Sheet1”工作表是操作文件，“4的倍数“工作表、“6的倍数“工作表、“8的倍数“工作表、“25的倍数“工作表是手动制作的，见图Sheet1、4的倍数、6的倍数、8的倍数、25的倍数，是要达到的模拟效果，操作文件见附件，谢谢高手！

3190496160

目前的文件中没有代码，没法看，但是，要解决不同班级分开的问题，那就每个班级生成一个word文档不就行了吗

lc16whj

3190496160 发表于 2024-10-12 09:29
目前的文件中没有代码，没法看，但是，要解决不同班级分开的问题，那就每个班级生成一个word文档不就行了吗

代码需要高手您帮我制作一下，这个文件是邮件合并的数据源文件，要利用附件里的文件，生成准考证。用插空行的思想进行分班打印！

longwin

longwin

代码供参考...

Sub test()
    bs = 6 '倍数
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("sheet1").[a1].CurrentRegion
    For i = 2 To UBound(arr)
        bj = arr(i, 3)
        If bj <> "" Then
            If Not d.exists(bj) Then
                d(bj) = 1
            Else
                d(bj) = d(bj) + 1
            End If
        End If
    Next
    Sheets("Sheet1").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Set sh = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    sh.Name = bs & "的倍数新"
    With sh
        bj = ""
        For i = UBound(arr) To 1 Step -1
            If bj <> .Cells(i, 3) Then
                bj = .Cells(i, 3)
                rs = d(bj)
                ys = rs Mod bs
                If ys > 0 Then
                    For j = 1 To bs - ys
                        .Rows(i + 1).Insert
                    Next
                End If
            End If
        Next
    End With
    MsgBox "OK!"
End Sub

lc16whj

longwin 发表于 2024-10-12 10:08

谢谢高手，稍后测试一下！

ZHLK

做了一个样式表，直接运行宏就行，供参考
Sub 宏1()
aa = InputBox("请输入考场号：", 输入窗口, 1)
    ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "C:\Users\Administrator\Desktop\邮件合并数据文件\邮件合并数据文件.xlsm", _
        ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\Administrator\Desktop\邮件合并数据文件\邮件合并数据文件.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Da" _
        , SQLStatement:="SELECT * FROM `Sheet1$` where 考场=" & aa, SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
  With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        .Execute Pause:=False
    End With
      
   
End Sub

wangweihebtu

这个活我干过，但是我和你的思路不一样，我是直接将excle文件按照班级分成了多个文件，然后分班邮件合并进行打印的

wangweihebtu

3190496160 发表于 2024-10-12 09:29
目前的文件中没有代码，没法看，但是，要解决不同班级分开的问题，那就每个班级生成一个word文档不就行了吗

对呀，我就是这么分的，感觉简单问题复杂了

3190496160

wangweihebtu 发表于 2024-10-12 14:36
对呀，我就是这么分的，感觉简单问题复杂了

不知道楼主目前究竟是个什么思路，但是，个人觉得：如果是一个班级一个word文件，没有必要在班级之间插入什么空白号的吧
根据是你没有上传你的转考证的模板样式，所有的东西都可以用代码来完成的，也没有必要在繁琐的邮件合并，