首页 > 解决方案 > Markdown to Word:如何将纯文本标题和交叉引用转换为链接的 Word-ones?

问题描述

将 Markdown 编织到 Word 的问题是图形/表格标题是纯文本的,因此如果将新图形/表格添加到文档中并且未显示在图形/表格列表中,则不会更改。

那么如何制作真正的 Word 标题,这些标题链接到它们的交叉引用并可以显示在图形列表中?

标签: vbams-wordr-markdown

解决方案


您可以使用以下 VBA 脚本执行此操作。可能还有改进的方法,所以我很高兴有建设性的意见。

以下将“图 3:某些文本”之类的图形标题转换为“图 1.3:某些文本”,因此包括章节编号。如果要排除章节编号,不能简单地设置IncludeChapterNumber为 False,否则代码无法区分新旧标题。一种解决方案是设置IncludeChapterNumber为 False 并将新文本更改为“Figure 1. Some Text”。提示在代码中。

要更改表格标题,只需将“Figure”替换为“Table”并再次运行代码。

Sub Caption_Figure()
' This function converts simple text captions to real figure captions, which are correctly linked and can be displayed in the list of figures.
' Caution. The code will not work if there are too many spaces between "Figure" and its number!

    ' Make variables
        Dim originalCaption As String
        Dim LastCaption As String
        Dim IndexOfNewCaption As Integer
        Dim SearchFor As String
        Dim SearchIn As String
        Dim bfound As Boolean
        bfound = True
                
    ' Background settings of captions
        Call Caption_Figure_Background
            
    ' Start
    With Selection
        
        Do While bfound
        
            ' Search for caption
             With Selection.Find
                .Text = "Figure ([0-9]{1;8})(:)"  '1-8 digit numbers before a colon
                .Replacement.Text = ""
                .ClearFormatting
                .Forward = True
                .Wrap = wdFindContinue  ' Don't ask per pop-up if search should be continued
                .Format = False
                .MatchWholeWord = False
                .MatchCase = False
                .MatchSoundsLike = False
                .MatchWildcards = True
                .MatchAllWordForms = False
                bfound = .Execute
            End With
                            
            If bfound Then
                
                ' Split original; insert caption
                    With Selection
                    
                        ''''''''''''''''''''''''''''
                        ' Split original caption
                            Selection.Expand Unit:=wdParagraph
                            originalCaption = Selection.Text
                            originalCaption2 = Split(originalCaption, ":")  ' originalCaption2 consists of two parts: Figure/Figure # part and then the text after it
                            
                            
                        ''''''''''''''''''''''''''''
                        ' Insert new caption
                            ' Write << Title:=". " & originalCaption2(1) >> to add a dot between the Figure number and the text
                        
                            .InsertCaption _
                                Label:=wdCaptionFigure, _
                                Title:=": " & originalCaption2(1), _
                                Position:=wdCaptionPositionBelow, _
                                ExcludeLabel:=0
                    End With
                

                                       
                ' Delete old caption
                     ' Caution! Simple Search and Replace does not work if the search text is more than one line long. Then it is not recognized and the caption is created twice!
                     ' Therefore only the first x characters are searched here. X should not be so long, so that also shorter captions can be found.
                     ' 10 is too small. 50 too large

                     With Selection.Find
                         .Text = Left(originalCaption, 25)  ' Search for the first x Characters
                         .Replacement.Text = ""
                         .Forward = True
                         .Wrap = wdFindContinue
                         .Format = False
                         .MatchCase = False
                         .MatchWholeWord = False
                         .MatchWildcards = False
                         .MatchSoundsLike = False
                         .MatchAllWordForms = False
                         cfound = .Execute
                     End With
                     
                     ' Delete whole paragraph with old caption
                        If cfound Then
                            With Selection
                                Selection.Expand Unit:=wdParagraph
                                Selection.Delete
                            End With
                        End If
                     
                ' Find index of new caption
                    AllCaptions = (ActiveDocument.GetCrossReferenceItems(ReferenceType:="Figure"))
                    SearchFor = originalCaption2(1)
                    SearchFor = RemoveInvalidCharacters(SearchFor) ' originalCaption2(1))
                    SearchFor = Left(SearchFor, 40)
                    
                    For lngIndex = 1 To UBound(ActiveDocument.GetCrossReferenceItems(ReferenceType:="Figure"))
                        SearchIn = AllCaptions(lngIndex)
                        SearchIn = RemoveInvalidCharacters(SearchIn)
                        If InStr(SearchIn, SearchFor) > 0 Then
                            IndexOfNewCaption = lngIndex
                        End If
                    Next lngIndex
                    
                    If IndexOfNewCaption = 0 Then
                        Debug.Print "Error: Index not found"
                    End If
                    
                ' Find references to figure-captions
                        With Selection.Find
                            .Text = originalCaption2(0) & "[) ,.;:^13]" & "[!0-9]"  ' Workaround because VBA doesn't do Lookaheads
                            .Replacement.Text = ""
                            .Forward = True
                            .Wrap = wdFindContinue
                            .Format = False
                            .MatchWholeWord = False
                            .MatchCase = False
                            .MatchSoundsLike = False
                            .MatchWildcards = True
                            .MatchAllWordForms = False
                            .Execute
                        End With
                               
                        'If found: Insert crossreferences to the figure
                        Do While .Find.Found = True
                            LastCharacter = Right(Selection, 2) ' Workaround because VBA doesn't do Lookaheads
                        
                            With Selection
                                .InsertCrossReference _
                                    ReferenceType:="Figure", _
                                    ReferenceKind:=wdOnlyLabelAndNumber, _
                                    ReferenceItem:=IndexOfNewCaption, _
                                    InsertAsHyperlink:=True, _
                                    IncludePosition:=False
                                .InsertAfter LastCharacter   ' Workaround because VBA doesn't do Lookaheads
                            End With
                            .Collapse wdCollapseEnd
                            .Find.Execute
                    
                        Loop
            End If

        Loop  ' bfound-Loop

    End With

End Sub

Function RemoveInvalidCharacters(cleanMe As String) As String
    ' Adjusted Code from https://gist.github.com/brazilnut2000/5972654

    Dim objRegex As Object
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Pattern = "[\-\<\>\*\'\,\$\#\@\.\?\!\/\[\]\:\|\\\/\?|0-9]"
        .Global = True
        RemoveInvalidCharacters = .Replace(cleanMe, "")
    End With
End Function

Sub Caption_Figure_Background()
Debug.Print ("Do Caption_Figure_Background")

    With CaptionLabels("Figure")
        .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True   ' Change to False if chapter numbers are not to be included. Caution: Also change new text!
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorPeriod  ' = Value 1. Figure 1.1
    End With
            
End Sub

请记住:此代码包括章节编号。因此,如果您的文档中没有标题 1,您将收到错误消息“错误!文档中没有指定样式的文本”


推荐阅读