请教高手：如何批量修改书签中文本内容？

gemj

请教高手：如何批量修改书签中文本内容？

如果把这个文档中带圈的数字改一下形式，好比把

①②③④⑤⑥⑦

分别改成：

[1][2][3][4][5][6][7]

如果直接作文字替换的话，因为带圈数字是有书签的，书签也被替换掉了。

所以，只能是通过VBA来修改书签中的文本内容（也就是超链接的anchor吧？）来进行了。

搜索了下本论坛，有这段代码，但最后一句貌似有问题：

Sub 修改书签文本内容() '先选中你要改的书签文本

    Dim doc As Document, Rng As Range, mbookName$

    Set doc = ActiveDocument

    If Selection.Bookmarks.Count = 0 Then Exit Sub

    Set Rng = Selection.Bookmarks(1).Range

    mbookName = Selection.Bookmarks(1).Name

    Rng.Text = "aaaaa"  '要改成什么自己写吧

    Rng.Bookmarks.Add mbookName, Rng

End Sub

请高手指教下，如何实现哦，谢谢啦！

ming0018

你的书签为什么可以以数字来命名？这是怎么做到的？

gemj

ming0018 发表于 2019-7-16 09:20
你的书签为什么可以以数字来命名？这是怎么做到的？

还真是。
不过这些书签，不是我自己添加的。
这个文档，是由从网上下载的EPUB电子书转化为DOCX格式得来的。
就有了这些书签。
谢谢啦！

daibao88

书签名以阿拉伯数字命名，不符合命名规则，没法在更改后还原。

gemj

daibao88 发表于 2019-7-16 16:16
书签名以阿拉伯数字命名，不符合命名规则，没法在更改后还原。

修改规范了，第二个附件是修改后的。谢谢大侠们啦！

daibao88

Sub test()
    Dim d As Object, nm As String, rg As Range, bkm As Bookmark, str As String
    Set d = CreateObject("scripting.dictionary")
    d("①") = "[1]"
    d("②") = "[2]"
    d("③") = "[3]"
    d("④") = "[4]"
    d("⑤") = "[5]"
    d("⑥") = "[6]"
    d("⑦") = "[7]"
    For Each bkm In ActiveDocument.Bookmarks
        nm = bkm.Name
        Set rg = bkm.Range
        str = rg.Text
        If d.Exists(str) Then
            rg.Text = d(str)
            ActiveDocument.Bookmarks.Add nm, rg
        End If
    Next
End Sub

gemj

daibao88 发表于 2019-7-16 19:47
Sub test()
    Dim d As Object, nm As String, rg As Range, bkm As Bookmark, str As String
    Set  ...

实在太感谢啦！

gemj

daibao88 发表于 2019-7-16 19:47
Sub test()
    Dim d As Object, nm As String, rg As Range, bkm As Bookmark, str As String
    Set  ...

书签处理非常完美！
不过超链接丢失了。
方便改进下代码，把超链接保留下来？
感谢感谢！

daibao88

Sub test()
    Dim d As Object, nm As String, rg As Range, bkm As Bookmark, str As String, adr As String
    Set d = CreateObject("scripting.dictionary")
    d("①") = "[1]"
    d("②") = "[2]"
    d("③") = "[3]"
    d("④") = "[4]"
    d("⑤") = "[5]"
    d("⑥") = "[6]"
    d("⑦") = "[7]"
    For Each bkm In ActiveDocument.Bookmarks
        nm = bkm.Name
        Set rg = bkm.Range
        str = rg.Text
        If rg.Hyperlinks.Count >= 1 Then adr = rg.Hyperlinks(1).SubAddress
        If d.Exists(str) Then
            rg.Text = d(str)
            ActiveDocument.Bookmarks.Add nm, rg
            If Len(adr) > 0 Then ActiveDocument.Hyperlinks.Add Anchor:=rg, SubAddress:=adr
        End If
        adr = ""
    Next
End Sub

sylun

可试试如下代码（针对第一个附件）

1. Sub test()
   
2.     Const conNom As String = "①②③④⑤⑥⑦⑧⑨⑩"
   
3.     Dim i As Byte
   
4.     Dim aBookmark As Bookmark
   
5.     Dim myFont As Font
   
6.    
   
7.     Application.ScreenUpdating = False

复制代码