EXEL VBA 判断删除WORD文档页问题

kangkumbong

大家好 通过EXCEL VBA 判断删除WORD文档中指定页，但是 下面IF判断立即窗口显示正常但是总是删除不了WORD文档的第2页
不知哪里出现了问题 也没有错误警告

谢谢

Sub BVTEST()
On Error Resume Next
Dim arr
Application.DisplayAlerts = False
Application.ScreenUpdating = False
path = "D:\SM\CIELO ORDER\OB TEST\BV TEST" & "\"
arr = Sheets("OB").Rows(ActiveCell.Row).Rows
Dim wdcx As Object
Dim wd As Object
Set wdcx = CreateObject("word.application")
Set wd = wdcx.Documents.Open(path & "\BV TEST DEMO.docm")
wdcx.Visible = True '显示打开WORD文档
'wdcx.Visible = False '不显示打开WORD文档
    With wdcx
        .ActiveDocument.tables(4).Cell(1, 2).Range.Text = arr(1, 7)
        .ActiveDocument.tables(4).Cell(3, 2).Range.Text = arr(1, 5) & " / " & arr(1, 13)
        .ActiveDocument.tables(4).Cell(3, 4).Range.Text = arr(1, 8)
        .ActiveDocument.tables(4).Cell(5, 2).Range.Text = arr(1, 22)
        .ActiveDocument.tables(4).Cell(6, 2).Range.Text = arr(1, 4) & " " & arr(1, 13)
        .ActiveDocument.tables(5).Cell(1, 1).Range.Text = arr(1, 20) & " TEST"
        .ActiveDocument.tables(5).Cell(2, 1).Range.Text = arr(1, 24)
        .ActiveDocument.tables(6).Cell(1, 2).Range.Text = Date
        .ActiveDocument.tables(8).Cell(1, 2).Range.Text = Date
    End With
'      If wd.ActiveDocument.tables(5).Cell(1, 1).Range.Text = "*PACKAGE TEST*" Then
'            wd.ActiveDocument.Selection.Goto wdGoToPage, wdGoToAbsolute, 2
'            wd.ActiveDocument.Selection.EndKey Unit:=wdStory, Extend:=wdExtend
'            wd.ActiveDocument.Selection.Delete
'            wd.ActiveDocument.Selection.TypeBackspace
'      End If
wd.SaveAs path & arr(1, 4) & " " & arr(1, 5) & " " & arr(1, 13) & " " & arr(1, 22) & " " & arr(1, 20) & " TEST.docx"
wd.Close
wdcx.Quit
Set wdcx = Nothing
Set wd = Nothing
MsgBox arr(1, 4) & " " & arr(1, 5) & " " & arr(1, 13) & " " & arr(1, 22) & " " & arr(1, 20) & " TEST文件已生成"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub