VBA 刪除頁

怎麼讓word自動刪除第三、六、九、12等3的倍數頁‘

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 With
End Sub

VBA實現檢查和刪除Word中的空白頁

Sub GetBlankPage()
Dim IsDelete As Boolean
Dim PageCount As Long
Dim rRange     As Range
Dim iInt     As Integer, DelCount As Integer
Dim 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 If
End Sub

　　

 

Sub AA()

Dim myRange As Range

Dim wNum As Integer
Dim wPag As Integer
Dim start As Integer

wPag = Selection.Information(wdNumberOfPagesInDocument)
Selection.GoTo wdGoToPage, wdGoToAbsolute, 3
MsgBox (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