怎么让word自动删除第3、6、9、12等3的倍数页‘
|
1
2
3
4
5
6
7
8
9
10
11 |
Sub kk1206190933() Dim wNum As Integer Dim wPag As Integer With Selection wPag = .Information(wdNumberOfPagesInDocument) For wNum = Int(wPag / 3) * 3 To 3 Step -3 .GoTo wdGoToPage, , wNum .Bookmarks("\Page").Range.Delete Next End WithEnd Sub |
VBA实现检查和删除Word中的空白页
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69 |
Sub GetBlankPage()Dim IsDelete As BooleanDim PageCount As LongDim rRange As RangeDim iInt As Integer, DelCount As IntegerDim tmpstr As String IsDelete = True PageCount = ThisDocument.BuiltInDocumentProperties(wdPropertyPages) For iInt = 1 To PageCount ‘超过PageCount退出 If iInt > PageCount Then Exit For ‘取每一页的内容 If iInt = PageCount Then Set rRange = ThisDocument.Range( _ Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start) Else Set rRange = ThisDocument.Range( _ Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start, _ End:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt + 1).Start _ ) End If If Replace(rRange.Text, Chr(13), "") = ""
Or Replace(rRange.Text, Chr(13), "") = Chr(12) Then tmpstr = tmpstr & "第 "
& iInt & " 页是空页"
& vbCrLf ‘删除? If IsDelete Then DelCount = DelCount + 1 ‘删除空白页 rRange.Text = Replace(rRange.Text, Chr(13), "") rRange.Text = "" ‘重算页数 PageCount = ThisDocument.BuiltInDocumentProperties(wdPropertyPages) If iInt <> PageCount Then ‘页删除后，页码变化，重新检查当前页 iInt = iInt - 1 Else ‘最后一个空页 Set rRange = ThisDocument.Range( _ Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, PageCount - 1).Start, _ End:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, PageCount + 1).Start _ ) ‘如果是分页符,删除上一页中的换页符 If InStr(1, rRange.Text, Chr(12)) > 0 Then rRange.Characters(InStr(1, rRange.Text, Chr(12))) = "" Else ‘没有分页符,通过选中后删除,最好不这样做，如果判断错误，有误删除的风险 Set rRange = ThisDocument.Range( _ Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start) rRange.Select Selection.Delete End If Exit For End If End If End If Next If 1 = 1 Or Not IsDelete Then If tmpstr = ""
Then MsgBox "没有空页", vbInformation + vbOKOnly Else MsgBox tmpstr, vbInformation + vbOKOnly End If Else If DelCount > 0 Then MsgBox "删除空页 "
& DelCount, vbInformation + vbOKOnly End IfEnd Sub |
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30 |
Sub AA()Dim myRange As RangeDim wNum As IntegerDim wPag As IntegerDim start As IntegerwPag = Selection.Information(wdNumberOfPagesInDocument)Selection.GoTo wdGoToPage, wdGoToAbsolute, 3MsgBox (Selection.Range.start & "+"
& Selection.Range.End)start = Selection.Range.start ‘.EndKey Unit:=wdStory ‘myRange.End = .Range.Start ‘MsgBox (myRange.Text) ‘If Replace(.Range.Text, Chr(13), "") = ""
Or Replace(.Range.Text, Chr(13), "") = Chr(12) Then ‘.Bookmarks("\Page").Range.Delete ‘End If Selection.EndKey Unit:=wdStory Selection.Select MsgBox (Selection.Range.start & "+"
& Selection.Range.End) ‘Set myRange = ActiveDocument.Range(ActiveDocument.GoTo(wdGoToPage, wdGoToAbsolute, 3).start, End:=ActiveDocument.GoTo(wdGoToPage, wdGoToAbsolute, 3).start) Set myRange = ActiveDocument.Range(start, End:=Selection.start) MsgBox (myRange.Text) End Sub |
原文：http://www.cnblogs.com/skykang/p/3601044.html