按班级分页打印，每班打印一页

myang7294528

现在有一个年级的学生考场安排表，需要按班给学生打印出来。因为wod中有分栏命令，所以分栏后每班可以打印在一页上，但是班级较多，如果各班手动插入分页符也麻烦。请高手能否指点有什么方法可以自动在各班最后插入分页符！

踏雪访梅

数据这东西，感觉用EXCEL处理比用WORD处理方便得多啊。

413191246se

1. Sub aaaa班号分配()
   
2.     Dim i$, j$
   
3.     ActiveDocument.Tables(1).Cell(2, 1).Select
   
4.     j = 1
   
5.     With Selection
   
6.         Do
   
7.             .MoveEnd unit:=wdCharacter, Count:=-1
   
8.             i = .Text
   
9.             If i <> j Then
   
10.                 j = i
    
11.                 .InsertBreak
    
12.                 .Next(4, 1).Select
    
13.             Else
    
14.                 .Next(4, 6).Select
    
15.                 If Not .Information(12) Then Exit Do
    
16.             End If
    
17.         Loop
    
18.         .HomeKey unit:=wdStory
    
19.         With .Find
    
20.             .ClearFormatting
    
21.             Do While .Execute("^12^13", , , 1, , , 1)
    
22.                 With .Parent
    
23.                     .Font.Size = 1
    
24.                     With .ParagraphFormat
    
25.                         .LineSpacing = LinesToPoints(0.06)
    
26.                         .AutoAdjustRightIndent = False
    
27.                         .DisableLineHeightGrid = True
    
28.                     End With
    
29.                 End With
    
30.             Loop
    
31.         End With
    
32.     End With
    
33.     ActiveDocument.PageSetup.TextColumns.Add Width:=CentimetersToPoints(6.95), _
    
34.          Spacing:=CentimetersToPoints(0.75), EvenlySpaced:=False
    
35. '
    
36.     Dim t As Table
    
37.     For Each t In ActiveDocument.Tables
    
38.         t.Rows(1).Select
    
39.         Selection.Font.Bold = True
    
40.         With Selection
    
41.             .InsertRows 1
    
42.             .Rows.HeadingFormat = True
    
43.             .TypeText Text:="班号"
    
44.             .MoveRight unit:=wdCell
    
45.             .TypeText Text:="姓名"
    
46.             .MoveRight unit:=wdCell
    
47.             .TypeText Text:="考号"
    
48.             .MoveRight unit:=wdCell
    
49.             .TypeText Text:="考场"
    
50.             .MoveRight unit:=wdCell
    
51.             .TypeText Text:="座号"
    
52.         End With
    
53.     Next
    
54.     ActiveDocument.Tables(1).Rows(2).Delete
    
55.     Selection.HomeKey unit:=wdStory
    
56.     MsgBox "OK"
    
57. End Sub

复制代码