刪除Word全部文字方塊

Sub DeleteAllDocInfoShapes()
Dim oShp As Word.Shape
Dim i As Long
vResponse = MsgBox("Delete All DocInfoShapes ? ", vbYesNoCancel, "刪除文字方塊")
For i = ActiveDocument.Shapes.Count To 1 Step -1
Set oShp = ActiveDocument.Shapes(i)
If oShp.Name Like "DocInfoShape*" And vResponse = vbYes Then
oShp.Delete
End If
Next i

End Sub

Sub DeleteDocInfoShape()

Dim shp As Shape, intNbrShapes As Integer, vResponse As Variant
Dim strBoxNbr As String, intBoxNbr As Integer, strMsg As String

intNbrShapes = 0
For Each shp In ActiveDocument.Shapes
'If shp.Type = msoTextBox Then
If shp.Name Like "DocInfoShape*" Then
intNbrShapes = intNbrShapes + 1
shp.Select
' Scroll through the active document so that the current selection is visible in the document window.
ActiveWindow.ScrollIntoView Selection.Range, True
strMsg = shp.TextFrame.TextRange.Text


vResponse = MsgBox("Text box name: " & shp.Name & vbCrLf & "Text Contents: " & strMsg & vbCrLf & "Delete?", vbYesNoCancel, "Finding Text Boxes")
shp.Select
If vResponse = vbYes Then ' User chose Yes.
shp.Delete
Else
If vResponse = vbCancel Then
Exit Sub
End If
End If
End If
Next shp


End Sub




Sub DeleteAllDocInfoShape()
Dim oShp As Word.Shape
Dim i As Long
vResponse = MsgBox("Delete All DocInfoShape ? ", vbYesNoCancel, "Finding Text Boxes")
For i = ActiveDocument.Shapes.Count To 1 Step -1
Set oShp = ActiveDocument.Shapes(i)
If oShp.Name Like "DocInfoShape*" & vResponse = vbYes Then
oShp.Delete
End If
Next i
End Sub