CommentThread内にリンクを挿入したい

投稿者 : さとう     投稿日時 : 2024/12/05(Thu) 09:46:30     OS : Windows 10     EXCEL : Office 365

---

手動ではコメント内にリンクを貼り付けることでリンク先のファイルを開けるようになりますが、これをVBAで実装したいです。

投稿者 : ごんぼほり     投稿日時 : 2024/12/05(Thu) 11:44:36

---

マクロの記録をしてみると

Sub Macro1()
    Range("A1").AddCommentThreaded ( _
        "https://www.239-programing.com/cgi-bin/excelvba_bbs.cgi?id=2060")
End Sub

のようになりますが、これを実行しても、ハイパーリンクにならずにただの文字列になってしまいます。

検索したところ、同様の質問がありましたが、未解決です。
https://eileenslounge.com/viewtopic.php?style=33&t=40208

こんなだとどうかと思ったけど無理でした

Sub test()
    Range("A1").AddCommentThreaded ("<a href=""https://www.239-programing.com/cgi-bin/excelvba_bbs.cgi?id=2060"">commnet</a>")
End Sub

投稿者 : らたたた     投稿日時 : 2024/12/06(Fri) 14:30:48

---

私のは2016なので
AddCommentThreaded
はエラーが出ますが、
なんとなく、コメント欄にカーソルを置いて
センドキー、enterだとどうなりますかね？
セルに、urlを書き込んだ時にもこれがないとダメだったので

投稿者 : ごんぼほり     投稿日時 : 2024/12/06(Fri) 14:45:01

---

■[返信 2] らたたたさん（2024-12-06 14:30:48）の記事
＞ なんとなく、コメント欄にカーソルを置いて
＞ センドキー、enterだとどうなりますかね？
＞ セルに、urlを書き込んだ時にもこれがないとダメだったので

以下のことを試しましたが、セル内に文字列が書き込まれるだけで、コメントのダイアログに書き込むことが出来ませんでした。

Sub test1()
   Application.CommandBars.ExecuteMso "NewThreadedComment"
   Application.SendKeys "https://www.239-programing.com/cgi-bin/excelvba_bbs.cgi?id=2060" & "^{ENTER}"
End Sub

Sub test2()
   Application.CommandBars.ExecuteMso "NewThreadedComment"
   CreateObject("WScript.Shell").SendKeys "https://www.239-programing.com/cgi-bin/excelvba_bbs.cgi?id=2060" & "^{ENTER}", False
End Sub

ExecuteMso "NewThreadedComment"　は、リボンの校閲タブ=>コメント=>新規コメントです
SendKyes で、最後に ^{ENTER} しているのは、コメントの投稿が Ctrl+Enter　のためです。

・DoEventsを複数回実行
・Applicaiton.Wait で時間稼ぎ
・Windows APIの Sleep関数 で時間稼ぎ
上記の全部結果が変わらず、SendKeysした文字列がセルに書き込まれて終わりです

投稿者 : ごんぼほり     投稿日時 : 2024/12/06(Fri) 15:05:34

---

昨日は以上までを試しただけで諦めましたが、
先ほどの助言を受けてもうちょっと頑張ってみました。

結果、私の環境ではこれでできました。ループ回数やSleepの時間はなにが最適かよくわかりません

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub test3()
   Application.CommandBars.ExecuteMso "NewThreadedComment"
   For i = 1 To 10
      Sleep 10
      DoEvents
   Next
   Application.SendKeys "https://www.239-programing.com/cgi-bin/excelvba_bbs.cgi?id=2060"
   Application.SendKeys "^{ENTER}"
End Sub

投稿者 : ごんぼほり     投稿日時 : 2024/12/06(Fri) 15:28:54

---

不安定で出来たり出来なかったり　
正直使い物にならない印象です。

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub sample()
   AddThreadedCommentURL "https://www.239-programing.com/cgi-bin/excelvba_bbs.cgi?id=2060", 30
End Sub
Sub AddThreadedCommentURL(URL As String, Optional ByVal wTime As Long = 20)
   Application.CommandBars.ExecuteMso "NewThreadedComment"
   For i = 1 To wTime: Sleep wTime: DoEvents: Next
   SendKeys URL
   For i = 1 To wTime: Sleep wTime: DoEvents: Next
   SendKeys "^{ENTER}"
End Sub

投稿者 : らたたた     投稿日時 : 2024/12/07(Sat) 06:48:44

---

net上には詐欺とかウイルスとか色々あるので簡単にはできないようになっているのでしょうね

投稿者 : tek     投稿日時 : 2024/12/07(Sat) 19:34:39

---

Excel2021ではurl対応していないので、壊れたパソコンのハードディスクを使用してExcel2016（Office Premium）で動作させてみました。
大変でした。
動作確認いただけるとうれしいです。

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)

Sub test()
    AddThreadedCommentURL "https://www.239-programing.com/cgi-bin/excelvba_bbs.cgi?id=2060"
End Sub

Private Sub AddThreadedCommentURL(url As String)
    Application.OnTime Now(), "'AddThreadedCommentSub " & """" & url & """" & "'"
    Application.CommandBars.ExecuteMso "NewThreadedComment"
End Sub

Sub AddThreadedCommentSub(url As String)
    wTime = 50  '30以上でいける 2度目からは5以上で行ける
    For i = 1 To wTime
        Sleep 1
        DoEvents: DoEvents
    Next
    CreateObject("WScript.Shell").SendKeys url & " {BS}^{ENTER}"
End Sub

投稿者 : ごんぼほり     投稿日時 : 2024/12/09(Mon) 08:49:39

---

元質問者を置いてきぼりにして回答してしまいますが、
tekさんのコードきちんと動きます。

私のコードは、コメントウインドウを出していると、セルにURLが張り付いてしまいますが、
tekさんのコードは、コメントウインドウを表示していても、対応できているようです

投稿者 : tek     投稿日時 : 2024/12/09(Mon) 09:34:45

---

ごんぼほりさん動作確認ありがとうございます。
所詮、SendKeysですので完全動作は望めませんが、他の方法で実現させる技量が無いので仕方有りません。

投稿者 : さとう     投稿日時 : 2024/12/18(Wed) 15:20:43

---

■[返信 9] tekさん（2024-12-09 09:34:45）の記事
＞ ごんぼほりさん動作確認ありがとうございます。
＞ 所詮、SendKeysですので完全動作は望めませんが、他の方法で実現させる技量が無いので仕方有りません。
＞


tekさんありがとうございます。
正直諦めていたのですが、回答いただけて助かりました!!

完全ではないとのことですが、そのあたりどうするかは自分で考えてやってみようと思います。