Word中使用vba清空超链接，一直未找到完美的解决方案，求助高人！

xiaoyouxi01

【需求】
我希望用一段vba代码，运行一次，即可清空当前Word文档中的所有超链接。
在网上搜了好久，一直没找到完美的解决方案。
比如下面的思路1（Ctrl+Shift+F9），无法清除图片或形状的超链接。
而思路2，则碰到修订中有已删除的超链接时，会报错。

【思路1】

1. Sub M1()
   
2.     Selection.WholeStory
   
3.     Selection.Fields.Unlink
   
4. End Sub

复制代码

全选后，用Selection.Fields.Unlink，也就是先Ctrl+A，再Ctrl+Shift+F9。
这个方法无法清除图片或是形状的超链接。

【思路2】

1. Sub M2()
   
2.     With ActiveDocument.Hyperlinks
   
3.         Do While .Count > 0
   
4.             .Item(1).Delete
   
5.         Loop
   
6.     End With
   
7. End Sub

复制代码

这个思路是，只要超链接计数大于0，就一直删除编号为1的超链接，直到超链接计数为0。
但如果修订内容中存在被删除的超链接，此时运行代码会报错。
有没有什么方法可以绕过修订中被删的超链接？

放上Word测试文档（已开启修订模式，修订内容中包含已删除的超链接，不要关闭修订，也不要接受修订）：
测试文档.rar (18.33 KB, 下载次数: 13)

2018-1-22 16:21 上传

点击文件名下载附件

活在理想的世界

清空超链接？

1. Sub D()
   
2. Dim shp As Shape
   
3. Cells.ClearHyperlinks: Cells.ClearFormats
   
4. For Each shp In ActiveSheet.Shapes
   
5.     shp.Hyperlink.Delete
   
6. Next
   
7. End Sub

复制代码

xiaoyouxi01

活在理想的世界 发表于 2018-1-22 16:30
清空超链接？

忘记说是Word文档了，不好意思。。

活在理想的世界

xiaoyouxi01 发表于 2018-1-22 16:48
忘记说是Word文档了，不好意思。。

是我不好意思，这里是word板块。我不该来这的。

lss001

Sub SFHyperlinks()'取消文字图片形状超链接
On Error Resume Next
ActiveDocument.Shapes.SelectAll'任何形状
Selection.ShapeRange.Hyperlink.Delete
For Each f In ActiveDocument.Fields'任何文字
    If f.Type = wdFieldHyperlink Then f.Unlink
Next
WordBasic AcceptAllChangesInDoc
End Sub

leikaiyi123

Sub SFHyperlinks2()    '取消文字图片形状(含文字)超链接
    On Error Resume Next
    Dim oshape As Shape
    For Each oshape In ActiveDocument.Shapes    '任何形状、图片
        oshape.Hyperlink.Delete
        oshape.TextFrame.TextRange.Fields.Unlink  '图形文本框中的文字
    Next

    For Each oField In ActiveDocument.Fields    '任何文字
        If oField.Type = wdFieldHyperlink Then oField.Unlink
    Next
End Sub

xiaoyouxi01

leikaiyi123 发表于 2018-1-22 23:14
Sub SFHyperlinks2()    '取消文字图片形状(含文字)超链接
    On Error Resume Next
    Dim oshape As  ...

厉害！文本框中的文字超链接也清除了！

如果是这样的话，文本框中可以有文字超链接，也可以有图片超链接，这个如何清除？

leikaiyi123

文本框中有图片？嵌入式的图片的超链接吧？你试试上面的代码，能清除吧。

xiaoyouxi01

leikaiyi123 发表于 2018-1-23 10:15
文本框中有图片？能上传附件吗？

测试文档2.rar (22.42 KB, 下载次数: 8)

2018-1-23 10:27 上传

点击文件名下载附件

文本框和椭圆形状，自身都有超链接。
文本框和椭圆形状内的文字有超链接。
文本框内的图片也有超链接。

插入文本框或形状后，剪切到文本框内，会自动变成图片。。。所以文本框内嵌套文本框或形状的情况，应该是没有了。

leikaiyi123

xiaoyouxi01 发表于 2018-1-23 10:27
文本框和椭圆形状，自身都有超链接。
文本框和椭圆形状内的文字有超链接。
文本框内的图片也有超链 ...

再试试：Sub SFHyperlinks2()    '取消文字图片形状(含文字)超链接
    On Error Resume Next
    Dim oshape As Shape, oinlineshape As InlineShape, olink As Hyperlink
    For Each oshape In ActiveDocument.Shapes        '任何形状
        oshape.Hyperlink.Delete
        oshape.TextFrame.TextRange.Fields.Unlink    '图形文本框中的文字
        For Each olink In oshape.TextFrame.TextRange.Hyperlinks
            olink.Delete
        Next

        If Val(Application.Version) > 12 Then
            For Each oinlineshape In oshape.TextFrame.TextRange.InlineShapes    '此3句仅适用word2010,在word2003中会卡死
                oinlineshape.Hyperlink.Delete       '浮动或嵌入式图形中的嵌入式图片
            Next
        End If
    Next

    For Each oinlineshape In ActiveDocument.InlineShapes    '此3句在word2003中可不用
        oinlineshape.Hyperlink.Delete           '嵌入式图片
    Next

    For Each oField In ActiveDocument.Fields    '任何文字
        If oField.Type = wdFieldHyperlink Then oField.Unlink
    Next
End Sub