英文:
In VBA, how do I add a hyperlink to my comment object?
问题
I am trying to create macros in Word to insert comments I frequently need to add to my documents.
我正在尝试在Word中创建宏,以插入我经常需要添加到我的文档中的注释。
I want to be able to add text, and below a hyperlink that leads to the source where this text was taken.
我希望能够添加文本,并在下面添加一个超链接,该超链接指向获取此文本的源。
Here what the code looks like. I suspect the problem is with the ActiveDocument.Hyperlink.Add part, but I can't find a solution to make my macro target the active comment object rather than the ActiveDocument...
以下是代码的外观。我怀疑问题出在ActiveDocument.Hyperlink.Add部分,但我找不到解决办法,使我的宏定位到活动注释对象而不是ActiveDocument...
Sub new_comment()
'
' new_comment Macro
'
Selection.Comments.Add Range:=Selection.Range, Text:= _
"This is my text."
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
"https://google.com" _
, SubAddress:="", ScreenTip:="", TextToDisplay:="This is my source"
End Sub
Any ideas?
有什么想法吗?
I tried manually adding the anchor text and the hyperlink while recording a macro and it didn't register my commands.
我尝试在录制宏时手动添加锚文本和超链接,但它没有记录我的命令。
=== UPDATE ===
Tim's solution below works well, then I tried adding multiple code blocks, one for each preset comment I want to run in Word. Every subsequent comment I add using these macros will insert the hyperlink anchor in the first comment of the document.
So, if I run the three macros below in order, new_comment_1 and new_comment_2 would anchor their hyperlink somewhere in new_comment. Any ideas on how to fix this?
Tim下面的解决方案效果很好,然后我尝试添加多个代码块,每个代码块对应我想在Word中运行的预设评论之一。使用这些宏添加的每个后续评论都会将超链接锚点插入文档的第一个评论中。
因此,如果我按顺序运行下面的三个宏,new_comment_1和new_comment_2将在new_comment中的某个地方锚定它们的超链接。有关如何修复此问题的任何想法吗?
Sub new_comment()
Dim cmt As Comment
Set cmt = Selection.Comments.Add(Range:=Selection.Range, _
Text:="This is my text. This is my source.")
HyperlinkComment cmt, "This is my source", "https://google.com"
End Sub
Sub HyperlinkComment(cmt As Comment, linkText As String, URL As String)
Dim p As Long, rng As Range
Set rng = cmt.Range
p = InStr(1, cmt.Range.Text, linkText, vbTextCompare)
If p > 0 Then
rng.SetRange Start:=p, End:=p + Len(linkText)
cmt.Parent.Hyperlinks.Add Anchor:=rng, Address:=URL
End If
End Sub
Sub new_comment_1()
Dim cmt As Comment
Set cmt = Selection.Comments.Add(Range:=Selection.Range, _
Text:="This is my second preset comment. This is my second source.")
HyperlinkComment cmt, "This is my second source.", "https://www.wikipedia.org/"
End Sub
Sub new_comment_2()
Dim cmt As Comment
Set cmt = Selection.Comments.Add(Range:=Selection.Range, _
Text:="This is my third preset comment. This is my third source.")
HyperlinkComment cmt, "This is my third source.", "https://www.un.org/en/"
End Sub
英文:
I am trying to create macros in Word to insert comments I frequently need to add to my documents.
I want to be able to add text, and below a hyperlink that leads to the source where this text was taken.
Here what the code looks like. I suspect the problem is with the ActiveDocument.Hyperlink.Add part, but I can't find a solution to make my macro target the active comment object rather than the ActiveDocument...
Sub new_comment()
'
' new_comment Macro
'
'
Selection.Comments.Add Range:=Selection.Range, Text:= \_
"This is my text."
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= \_
"https://google.com" \_
, SubAddress:="", ScreenTip:="", TextToDisplay:="This is my source"
End Sub
Any ideas?
I tried manually adding the anchor text and the hyperlink while recording a macro and it didn't register my commands.
=== UPDATE ===
Tim's solution below works well, then I tried adding multiple code blocks, one for each preset comment I want to run in Word. Every subsequent comment I add using these macros will insert the hyperlink anchor in the first comment of the document.
So, if I run the three macros below in order, new_comment_1 and new_comment_2 would anchor their hyperlink somewhere in new_comment. Any ideas on how to fix this?
Sub new_comment()
Dim cmt As Comment
Set cmt = Selection.Comments.Add(Range:=Selection.Range, _
Text:="This is my text. This is my source.")
HyperlinkComment cmt, "This is my source", "https://google.com"
End Sub
Sub HyperlinkComment(cmt As Comment, linkText As String, URL As String)
Dim p As Long, rng As Range
Set rng = cmt.Range
p = InStr(1, cmt.Range.Text, linkText, vbTextCompare)
If p > 0 Then
rng.SetRange Start:=p, End:=p + Len(linkText)
cmt.Parent.Hyperlinks.Add Anchor:=rng, Address:=URL
End If
End Sub
Sub new_comment_1()
Dim cmt As Comment
Set cmt = Selection.Comments.Add(Range:=Selection.Range, _
Text:="This is my second preset comment. This is my second source.")
HyperlinkComment cmt, "This is my second source.", "https://www.wikipedia.org/"
End Sub
Sub new_comment_2()
Dim cmt As Comment
Set cmt = Selection.Comments.Add(Range:=Selection.Range, _
Text:="This is my third preset comment. This is my third source.")
HyperlinkComment cmt, "This is my third source.", "https://www.un.org/en/"
End Sub
答案1
得分: 1
I've translated the code portion you provided:
**EDIT**: updated - removed the `SetRange` call in `HyperlinkComment` and used `MoveStart` / `MoveEnd` instead, which seems to have fixed things.
Something like this:
Sub Tester()
Dim doc As Document, i As Long
Set doc = ThisDocument
'for testing - remove any existing comments
For i = doc.Comments.Count To 1 Step -1
doc.Comments(i).Delete
Next i
new_comment doc.Paragraphs(1).Range, "This is my text. This is my source....", _
"This is my source", "https://google.com"
new_comment doc.Paragraphs(3).Range, "This is my text2. This is my source2....", _
"This is my source", "https://yahoo.com"
new_comment doc.Paragraphs(5).Range, "This is my text3. This is my source3....", _
"This is my source", "https://www.wikipedia.org"
End Sub
Sub new_comment(rng As Range, txt As String, linktxt As String, URL As String)
Dim cmt As Comment
Set cmt = rng.Parent.Comments.add(Range:=rng, Text:=txt)
HyperlinkComment cmt, linktxt, URL
End Sub
Sub HyperlinkComment(cmt As Comment, linkText As String, URL As String)
Dim p As Long, rng As Range, cmtLen As Long, p2 As Long
Set rng = cmt.Range
cmtLen = Len(rng.Text)
p = InStr(1, cmt.Range.Text, linkText, vbTextCompare)
p2 = p + Len(linkText)
If p > 0 Then
rng.MoveStart wdCharacter, p - 1
If p2 < cmtLen Then rng.MoveEnd wdCharacter, -(cmtLen - p2) - 1
cmt.Parent.Hyperlinks.add Anchor:=rng, Address:=URL
End If
End Sub
英文:
EDIT: updated - removed the SetRange
call in HyperlinkComment
and used MoveStart
/ MoveEnd
instead, which seems to have fixed things.
Something like this:
Sub Tester()
Dim doc As Document, i As Long
Set doc = ThisDocument
'for testing - remove any existing comments
For i = doc.Comments.Count To 1 Step -1
doc.Comments(i).Delete
Next i
new_comment doc.Paragraphs(1).Range, "This is my text. This is my source....", _
"This is my source", "https://google.com"
new_comment doc.Paragraphs(3).Range, "This is my text2. This is my source2....", _
"This is my source", "https://yahoo.com"
new_comment doc.Paragraphs(5).Range, "This is my text3. This is my source3....", _
"This is my source", "https://www.wikipedia.org"
End Sub
Sub new_comment(rng As Range, txt As String, linktxt As String, URL As String)
Dim cmt As Comment
Set cmt = rng.Parent.Comments.add(Range:=rng, Text:=txt)
HyperlinkComment cmt, linktxt, URL
End Sub
Sub HyperlinkComment(cmt As Comment, linkText As String, URL As String)
Dim p As Long, rng As Range, cmtLen As Long, p2 As Long
Set rng = cmt.Range
cmtLen = Len(rng.Text)
p = InStr(1, cmt.Range.Text, linkText, vbTextCompare)
p2 = p + Len(linkText)
If p > 0 Then
rng.MoveStart wdCharacter, p - 1
If p2 < cmtLen Then rng.MoveEnd wdCharacter, -(cmtLen - p2) - 1
cmt.Parent.Hyperlinks.add Anchor:=rng, Address:=URL
End If
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论