0

「Word Hacks: Tips & Tools for Taming Your Text」の次のコードは、選択したテキストを同一の内容の見出しに自動的に相互参照します。図のキャプションを同一の内容で自動的に相互参照するために微調整しようとしましたが、成功しませんでした。ユーザーが任意のテキスト行 (「詳細については、図 3-5 を参照してください」という段落など) で「図 3-5」を選択した場合、コードは対応する図のキャプションを探して、相互参照を自動的に挿入します。

Sub MakeAutoXRef() 
    Dim sel As Selection 
    Dim rng As range 
    Dim para As Paragraph 
    Dim doc As Document 
    Dim sBookmarkName As String 
    Dim sSelectionText As String 
    Dim lSelectedParaIndex As Long 
    Set sel = Selection 
    Set doc = sel.Document 
    If sel.range.Paragraphs.Count <> 1 Then Exit Sub 
    lSelectedParaIndex = GetParagraphIndex(sel.range.Paragraphs.First) 
    sel.MoveStartWhile cset:=(Chr$(32) & Chr$(13)), Count:=sel.Characters.Count 
    sel.MoveEndWhile cset:=(Chr$(32) & Chr$(13)), Count:=-sel.Characters.Count 
    sSelectionText = sel.text 
    For Each para In doc.Paragraphs 
        Set rng = para.range 
        rng.MoveStartWhile cset:=(Chr$(32) & Chr$(13)), _ 
        Count:=rng.Characters.Count 
        rng.MoveEndWhile cset:=(Chr$(32) & Chr$(13)), _ 
        Count:=-rng.Characters.Count 
        If rng.text = sSelectionText Then 
            If Not GetParagraphIndex(para) = lSelectedParaIndex Then 
                sBookmarkName = GetOrSetXRefBookmark(para) 
                If Len(sBookmarkName) = 0 Then 
                    MsgBox "Couldn't get or set bookmark" 
                    Exit Sub 
                End If 
                sel.InsertCrossReference _ 
                referencekind:=wdContentText, _ 
                referenceItem:=doc.Bookmarks(sBookmarkName), _ 
                referencetype:=wdRefTypeBookmark, _ 
                insertashyperlink:=True 
                Exit Sub 
            Else 
                MsgBox "Can't self reference!" 
            End If 
        End If 
    Next para 
End Sub 


Function RemoveInvalidBookmarkCharsFromString(ByVal str As String) As String 
    Dim i As Integer 
    For i = 33 To 255 
        Select Case i 
        Case 33 To 47, 58 To 64, 91 To 96, 123 To 255 
            str = Replace(str, Chr(i), vbNullString) 
        End Select 
    Next i 
    RemoveInvalidBookmarkCharsFromString = str 
End Function


Function ConvertStringRefBookmarkName(ByVal str As String) As String 
    str = RemoveInvalidBookmarkCharsFromString(str) 
    str = Replace(str, Chr$(32), "_") 
    str = "_" & str 
    str = "XREF" & CStr(Int(90000 * Rnd + 10000)) & str 
    ConvertStringRefBookmarkName = str 
End Function 


Function GetParagraphIndex(para As Paragraph) As Long 
    GetParagraphIndex = _ 
    para.range.Document.range(0, para.range.End).Paragraphs.Count 
End Function 


Function GetOrSetXRefBookmark(para As Paragraph) As String 
    Dim i As Integer 
    Dim rng As range 
    Dim sBookmarkName As String 
    If para.range.Bookmarks.Count <> 0 Then 
        For i = 1 To para.range.Bookmarks.Count 
            If InStr(1, para.range.Bookmarks(i).name, "XREF") Then 
                GetOrSetXRefBookmark = para.range.Bookmarks(i).name 
                Exit Function 
            End If 
        Next i 
    End If 
    Set rng = para.range 
    rng.MoveEnd unit:=wdCharacter, Count:=-1 
    sBookmarkName = ConvertStringRefBookmarkName(rng.text) 
    para.range.Document.Bookmarks.Add _ 
    name:=sBookmarkName, _ 
    range:=rng 
    GetOrSetXRefBookmark = sBookmarkName 
End Function
4

1 に答える 1

0

だから、私はあなたのポイントを得ると思います。正直なところ、insertCrossReferenceメソッドを使用するのは少し複雑です。これには1つの欠点があります。を設定すると、参照先のタイトルの「名前」全体が選択された範囲に配置されます。言い換えれば、あなたのタイトルが'図1.2の場合。1月の販売実績」で、「図1.2」をタイトルにリンクさせたい場合は、「図1.2」を長い元のタイトルに置き換えます。したがって、あなたが提示した基本的な考えは、段落の参照を保持します。しかし、私はいくつかの試行を行い、次のことを提案しました。a）MakeAutoXRefサブルーチンの代わりに、次のコードをモジュールに入れます。

Sub findToReference()

Dim whatTo As Range
Set whatTo = Selection.Range

Dim whatToTxt As String
    whatToTxt = whatTo.text
Dim sBookmarkName As String

Dim rngDoc As Range
Set rngDoc = ActiveDocument.Content

With rngDoc.find
    .text = whatTo
    .Style = "Headings 1"   'place name of style here, like 'Headings 1' or something
    .Execute
End With

If rngDoc.find.Found = True Then
    'rngDoc.Select     'selection what was fount
    'found text to bookmark
    sBookmarkName = GetOrSetXRefBookmark(rngDoc)
    'copy from previous
     If Len(sBookmarkName) = 0 Then
                MsgBox "Couldn't get or set bookmark"
                Exit Sub
    End If

    whatTo.InsertCrossReference _
                referencetype:=wdRefTypeBookmark, _
                referencekind:=wdContentText, _
                referenceItem:=rngDoc.Bookmarks(sBookmarkName), _
                insertashyperlink:=True
 Else
    MsgBox "No headers matching selection found!"

End If
End Sub

コメント：find選択したテキストを検索し、スタイル名が見出しを参照しているかどうかを確認する機能を使用することを提案します。Headings 1したがって、適切なスタイル名に変更する必要があります。もう1つのポイントは、最初の出現が一致し、選択したテキストへの参照を設定することです。

さらに、1つの機能を変更する必要があります。GetOrSetXRefBookmark元の機能を以下のものに置き換えます。

Function GetOrSetXRefBookmark(paraRng As Range) As String
Dim i As Integer
Dim rng As Range
Dim sBookmarkName As String
   sBookmarkName = ConvertStringRefBookmarkName(paraRng.text)
   paraRng.Bookmarks.Add _
      Name:=sBookmarkName, _
      Range:=paraRng
GetOrSetXRefBookmark = sBookmarkName
End Function

Word 2010では問題なく動作します。提示されたアイデアの欠点の1つは、それぞれcrossreferenceが新しいブックマークを作成するという状況です。しかし、元のコードから「段落の一致とフルネームのコピー」を取り除くことが私の唯一のアイデアでした。だから、あなたが私の主張を理解してくれることを願っています。それがお役に立てば幸いです。

于 2013-03-22T15:24:46.773 に答える