|
|
楼主 |
发表于 2024-7-8 09:32:50
|
显示全部楼层
Function hideRefHyperlink(fieldName, startFieldNumber)
Dim selectedRange As Range
Dim para As Paragraph
Dim bookmarkRange As Range
Selection.HomeKey Unit:=wdStory
For Each field In ActiveDocument.Fields
' Check if the field code contains the specified string
If InStr(1, field.Code.Text, fieldName, vbTextCompare) > 0 Then
' Check if the field is after the current cursor position
If field.Code.Start > currentPosition Then
' Select the field
field.Select
' Exit the loop after the first match (selecting the next occurrence)
Exit For
End If
End If
Next field
cursorStart = Selection.Range.Start
' Check if text is selected
If Selection.Type = wdSelectionIP Or cursorStart = -1 Then
MsgBox "Field NE.Lib not found.", vbExclamation
Exit Function
End If
Set selectedRange = Selection.Range
Set temprange = Selection.Range
' Loop through each paragraph in the selected range
For Each para In selectedRange.Paragraphs
If Len(para.Range.Text) > 1 Then
' Set the selected range
Set temprange = para.Range
temprange.MoveEnd Unit:=wdCharacter, Count:=-1
Selection.Collapse
Selection.Start = temprange.Start
Selection.End = temprange.End
If Selection.Paragraphs.Count > 1 Then
Set temp = Selection.Paragraphs(2).Range
Selection.Collapse
temp.Select
End If
Set bookmarkRange = para.Range
' Get the hyperlink address and alt text
temptext = bookmarkRange.Paragraphs(1).Range.Text ' Alt text is the entire paragraph
temptext = Replace(temptext, ChrW(8204), "") 'Remove zero-width space
If InStr(1, temptext, "DOI: ") > 0 Then
hyperlinkAddress = "https://doi.org/" & MidBetween(1, temptext, "DOI: ", ".$$")
If Right(hyperlinkAddress, 1) = "." Then hyperlinkAddress = Left(hyperlinkAddress, Len(hyperlinkAddress) - 1)
ElseIf InStr(1, temptext, "/OL]") > 0 Then
hyperlinkAddress = MidBetween(1, temptext, "/OL]. ", "." & vbCrLf)
If Right(hyperlinkAddress, 1) = "." Then hyperlinkAddress = Left(hyperlinkAddress, Len(hyperlinkAddress) - 1)
ElseIf InStr(1, temptext, "$$") > 0 Then
hyperlinkAddress = MidBetween(1, temptext, "$$", "$$")
Else
hyperlinkAddress = "#"
If Len(temptext) > 1 Then Debug.Print "No url for: " & Replace(temptext, vbCr, "")
End If
' Add the hyperlink
If hyperlinkAddress <> "#" Then
If Selection.Hyperlinks.Count = 0 Then Selection.Range.Hyperlinks.Add Anchor:=Selection.Range, Address:=hyperlinkAddress
End If
'Hide the temp hyperlink in bookmark range
If InStr(1, bookmarkRange.Text, "$$") > 0 Then
bookmarkRange.MoveStartUntil "$$"
bookmarkRange.MoveEnd wdCharacter, -1
bookmarkRange.Select
bookmarkRange.Font.Hidden = True
End If
End If
'Selection.Range.MoveStart Unit:=wdCharacter, Count:=1
Next para
Debug.Print "Hyperlink in Reference successfully hidden!"
End Function
Function SelectNextField(fieldName, startFieldNumber)
Dim field As field
Dim currentPosition As Long
SelectNextField = -1
' Get the current cursor position
currentPosition = Selection.Range.Start + 1
' Iterate through all fields in the document
For i = startFieldNumber To ActiveDocument.Fields.Count
Set field = ActiveDocument.Fields(i)
' Check if the field code contains the specified string
If InStr(1, field.Code.Text, fieldName, vbTextCompare) > 0 Then
' Check if the field is after the current cursor position
If field.Code.Start > currentPosition Then
' Select the field
field.Select
' Exit the loop after the first match (selecting the next occurrence)
SelectNextField = i
Set field = Nothing
Exit For
End If
End If
Next i
' Inform the user if no matching field is found
If Selection.Type = wdSelectionIP Then
SelectNextField = -1
Set field = Nothing
'MsgBox "No field with code containing '" & fieldName & "' found after the cursor position.", vbInformation
End If
End Function
Function FindStringInBookmarks(searchString As String) As String
Dim bookmark As bookmark
counter = 0
' Loop through all bookmarks in the document
For Each bookmark In ActiveDocument.Bookmarks
' Check if the search string is found in the bookmark's range
If InStr(1, bookmark.Name, searchString, vbTextCompare) = 1 Then
' Return the name of the first matching bookmark
FindStringInBookmarks = bookmark.Name
counter = counter + 1
End If
Next bookmark
' No match or more than one matches found
If counter = 0 Then
FindStringInBookmarks = "0"
ElseIf counter > 1 Then
FindStringInBookmarks = "+"
End If
End Function
Function inOneLine()
' Check if the selection range is within one line
With Selection.Range
originalEnd = Selection.Range.End
.Collapse Direction:=wdCollapseStart
t1 = .Information(wdFirstCharacterLineNumber)
.Start = originalEnd
t2 = .Information(wdFirstCharacterLineNumber)
inOneLine = (t1 = t2)
End With
End Function
Function MidBetween(nCursor, strText, strStart, strEnd)
Dim nStart, nEnd
If InStr(nCursor, strText, strStart) = 0 Then
MidBetween = ""
Else
nStart = InStr(nCursor, strText, strStart) + Len(strStart)
If InStr(nCursor, strText, strEnd) = 0 Then
nEnd = Len(strText)
Else
nEnd = InStr(nStart, strText, strEnd)
End If
MidBetween = Mid(strText, nStart, nEnd - nStart)
End If
End Function
Function getBookmarkName(strRef)
On Error GoTo errhandler
If strRef = "" Or InStr(1, strRef, ",") = 0 Then Exit Function
' Create a regular expression object
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "(.*?)(\d{4}[a-z\.-])" ' Match text until the first comma, followed by a 4-digit number and a period
tmp = Replace(strRef, " and ", ", ") & "."
tmp = regex.Execute(tmp)(0)
arr = Split(tmp, ", ")
For i = 0 To UBound(arr)
If InStr(1, arr(i), " ") Then
getBookmarkName = getBookmarkName & MidBetween(1, arr(i), "", " ") & "_"
Else
getBookmarkName = getBookmarkName & arr(i) & "_"
End If
Next i
getBookmarkName = Mid(getBookmarkName, 1, Len(getBookmarkName) - 1)
getBookmarkName = Replace(getBookmarkName, ".", "")
getBookmarkName = Replace(getBookmarkName, "(", "")
getBookmarkName = Replace(getBookmarkName, "-", "")
getBookmarkName = UCase(getBookmarkName)
If Right(getBookmarkName, 1) = "_" Then getBookmarkName = Mid(getBookmarkName, 1, Len(getBookmarkName) - 1)
Exit Function
errhandler:
Debug.Print Err.Description
getBookmarkName = ""
End Function |
|
发表于 2024-7-8 09:32:00
发表于 2024-7-11 16:31:02