Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Microsoft 365)
RSS情報を取得して、別の列にハイパーリンクの設定をしたい
投稿日時: 23/02/02 17:07:06
投稿者: takatada72

お世話になります。
 
今回、RSSを公開しているサイトから、情報を読み取って、シートに記載することができました。
ただ、URL部分がWクリックしても開かないため、ハイパーリンクを設定したいのですが、
コンパイル エラー: 構文エラーで止まってしまいました。
構文の何がいけないのでしょうか
宜しくお願い致します。
 
表示は、
タイトル URL 日付 のようには表示されました。
●で囲まれたコードを入れるとエラーになってしまいます。
※●は、削除しております。
 
お忙しいとは思いますが宜しくお願い致します。
☆★☆★☆★☆★☆★☆★☆★☆★★☆☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆★☆
Dim xmlDoc As Object, RSSURL As String, rCode As Boolean
Dim titleNodes, pubDateNodes, decriptNodes, sss, linkNodes, i As Integer, j As Integer
 
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    xmlDoc.async = False
    'イベント情報を取得
    RSSURL = "https://news.yahoo.co.jp/rss/categories/science.xml"
    rCode = xmlDoc.Load(RSSURL)
        If rCode = False Then
            MsgBox "読み込めませんでした。", vbCritical
            Exit Sub
        End If
     
    Set titleNodes = xmlDoc.SelectNodes("//item/title")
    Set decriptNodes = xmlDoc.SelectNodes("//item/description")
    Set linkNodes = xmlDoc.SelectNodes("//item/link")
    Set pubDateNodes = xmlDoc.SelectNodes("//item/pubDate")
     
    Cells(5, 1).Select
    Dim hyplink As Hyperlink
     
    '5件分のフィードを出力
    j = 0
    For i = 1 To 20
        With ActiveCell
            .Offset(j, 0).Value = titleNodes(i).Text
            .Offset(j, 1).Value = linkNodes(i).Text
            .Offset(j, 2).Value = Mid(pubDateNodes(i).Text, 6, 11)
 
        ●ActiveSheet.Hyperlinks.Add(Anchor:=Cells(j, 4), Address:=linkNodes(i).Text, TextToDisplay:=titleNodes(i).Text)●
 
        End With
 
        j = j + 1
    Next i
    

回答
投稿日時: 23/02/02 17:14:16
投稿者: simple

どこかのWebページへのリンクを挿入する動作をマクロ記録してみてはいかがですか?
それが参考になるはずです。

回答
投稿日時: 23/02/02 22:10:50
投稿者: simple

この質問ページへのハイパーリンクを張る動作を記録すると、下記になります。

Sub Macro1()
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "https://www.moug.net/faq/viewtopic.php?t=82038", TextToDisplay:= _
        "https://www.moug.net/faq/viewtopic.php?t=82038"
End Sub
引数をカッコで囲んだりしていないですよね。そのとおりに真似をしてもらえばOKです。
ちなみに、Cells(j, 4)は、 .Offset(j, 4) の単純ミスでしょう。(j=0のときにエラーになるので直ぐわかります)
 
助言のとおりにしていただければ、問題は簡単に解決するはずです。
マクロ記録なんか意味無いよ、ということで試していないとかですか?
 
=================
以下、理屈的なことを若干補足説明します。
 
(1)
Hyperlinks.Addメソッドはオブジェクトブラウザで確認すると
Function Add(Anchor As Object, Address As String, [SubAddress], [ScreenTip], [TextToDisplay]) As Object
Object(実際はhyperlinkオブジェクト)を返す Function で構築されています。
 
戻り値を必要としない場合は、マクロ記録のように、Subプロシージャー的な書き方ができるようです。
(これは Range1.Copy Range2 と同じです。
  Copy も Functionで定義されているので、
  ans = Range1.Copy(Range2) とも書けます(成功した場合、Trueを返します)が、
  普通こんな書き方はしません。)
 
(2)
Hyperlinks.AddメソッドはFunctionですから、
ActiveSheet.Hyperlinks.Add(Anchor:=Selection, Address:= URL1, TextToDisplay:=URL1)
                                                   (URL1は説明のための省略記法です)
と書くと、戻り値を戻す書き方であるにも関わらず戻り値指定がないなので、構文エラーになります。
 
(3)
Dim hl As Hypeylink
Set hl = ActiveSheet.Hyperlinks.Add(Anchor:=Selection, Address:= URL1, TextToDisplay:=URL1)
とすればエラーになりません。
 
(4)
なお、単に引数をカッコに入れたいのであれば、
Call ActiveSheet.Hyperlinks.Add(Anchor:=Selection, Address:= URL1, TextToDisplay:=URL1)
と書くこともできます。
(もっとも、これはSubプロシージャー的に扱ったものです。
  Callを使う時は、引数はカッコで囲む必要があるという制約に従っただけです)
 
異常の話は、次のVBAのヘルプが参考になると思います。
「Sub プロシージャと Function プロシージャの呼び出し」
https://learn.microsoft.com/ja-jp/office/vba/language/concepts/getting-started/calling-sub-and-function-procedures
# 私の記述は正確性を欠いたところがあるかもしれません。

回答
投稿日時: 23/02/03 08:45:41
投稿者: simple

誤字がありました。
最後のパラグラフの
「異常の話」 は 「以上の話」の間違いです。失礼しました。

投稿日時: 23/02/03 09:07:39
投稿者: takatada72

simpleさん
 
お疲れさまです。
ご丁寧にご説明をありがとうございました。
私のVBAのレベルがとても低いため、内容が殆ど理解できていません。
 
私なりに理解して、simpleさんが示された内容を追加してみました。
結果、RSSの記載開始位置にハイパーリンクの設定ができましたが、
その一行だけで、他の部分は、変わりませんでした。
※一行の中で、20件分の内容が変わっているようでした。
 
そちらを各行に配置されればいいのですが、理解力が乏しいため、
引き続きのご指導をお願いできないでしょうか
 
宜しくお願い致します。
 
 
こちらを登録しました。
Public Function call_ClipBoardSave(URL1 As String)
Dim hl As Hypeylink
Set hl = ActiveSheet.Hyperlinks.Add(Anchor:=Selection, Address:=URL1, TextToDisplay:=URL1)
End Function
 
●の部分を下記に変更しました。
    URL1 = linkNodes(i).Text
Call ActiveSheet.Hyperlinks.Add(Anchor:=Selection, Address:=URL1, TextToDisplay:=URL1)
 

投稿日時: 23/02/03 09:29:18
投稿者: takatada72

表示名も変えてみました。/表示名も表示されるようになりました。
あとは、表示位置の問題です。
 
お忙しいとは思いますが宜しくお願い致します。
 
Public Function call_ClipBoardSave(URL1, TitleName As String)
Dim hl As Hypeylink
Set hl = ActiveSheet.Hyperlinks.Add(Anchor:=Selection, Address:=URL1, TextToDisplay:=TitleName)
End Function
 
 
    URL1 = linkNodes(i).Text
    TitleName = titleNodes(i).Text
Call ActiveSheet.Hyperlinks.Add(Anchor:=Selection, Address:=URL1, TextToDisplay:=TitleName)

投稿日時: 23/02/03 10:16:19
投稿者: takatada72

simpleさん
 
お疲れさまです。
ハイパーリンクで表示されるようになります。
ただ、なぜか、ハイパーリンクが20件表示されるされるのですが、
日付がそれ以降も10行も表示されるようになりました。
 
あと少しです。
引き続きご指導を宜しくお願い致します。
 
Dim xmlDoc As Object, RSSURL As String, rCode As Boolean
Dim titleNodes, pubDateNodes, decriptNodes, sss, linkNodes, i As Integer, j As Integer
Dim URL1, TitleName As String
 
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    xmlDoc.async = False
    'イベント情報を取得
    RSSURL = "https://news.yahoo.co.jp/rss/categories/science.xml"
    rCode = xmlDoc.Load(RSSURL)
        If rCode = False Then
            MsgBox "読み込めませんでした。", vbCritical
            Exit Sub
        End If
     
    Set titleNodes = xmlDoc.SelectNodes("//item/title")
    Set decriptNodes = xmlDoc.SelectNodes("//item/description")
    Set linkNodes = xmlDoc.SelectNodes("//item/link")
    Set pubDateNodes = xmlDoc.SelectNodes("//item/pubDate")
     
' Cells(5, 1).Select
' Dim hyplink As Hyperlink
     
    '20件分のフィードを出力
    j = 0
 Range("A5").Activate
     
    For i = 1 To 20
        With ActiveCell
            .Offset(j + 1, 1).Value = Mid(pubDateNodes(i).Text, 6, 11)
ActiveCell.Offset(1, 0).Select
URL1 = linkNodes(i).Text
TitleName = titleNodes(i).Text
Call ActiveSheet.Hyperlinks.Add(Anchor:=Selection, Address:=URL1, TextToDisplay:=TitleName)
     
        End With
 
     
        j = j + 1
    Next i

回答
投稿日時: 23/02/03 10:20:05
投稿者: simple

再掲します。

引用:
引数をカッコで囲んだりしていないですよね。そのとおりに真似をしてもらえばOKです。
ちなみに、Cells(j, 4)は、 .Offset(j, 4) の単純ミスでしょう。
と回答したとおりです。
それだけのコードが書けるかたなら、わかると思いますが。

投稿日時: 23/02/03 10:52:41
投稿者: takatada72

 simpleさん
 
ありがとうございます。
 
コードは、ネットで探して、検証しながら、作っているので、理解していないのが事実です。
 
>ちなみに、Cells(j, 4)は、 .Offset(j, 4) の単純ミスでしょう。
こちらですが、.Offset(j, 4).Value =に変更するのですが、下記のコードをどのように表現
してよいのかがわかっていないのです。
 
もう少し、レベルを下げてご指導頂けないでしょうか
宜しくお願い致します。
 
Call ActiveSheet.Hyperlinks.Add(Anchor:=Selection, Address:=URL1, TextToDisplay:=TitleName)

回答
投稿日時: 23/02/03 10:57:38
投稿者: simple

当初のコードを前提にした修正案はこういうものです。
その後仕様が変わったとしたらその分を追加修正してください。(下記には反映していません)

    j = 0
    For i = 1 To 20
        With ActiveCell
            .Offset(j, 0).Value = titleNodes(i).Text
            .Offset(j, 1).Value = linkNodes(i).Text
            .Offset(j, 2).Value = Mid(pubDateNodes(i).Text, 6, 11)
            ActiveSheet.Hyperlinks.Add Anchor:=.Offset(j, 4), _
                  Address:=linkNodes(i).Text, TextToDisplay:=titleNodes(i).Text
        End With
        j = j + 1
    Next i

変更したのは、ここだけです。
      ActiveSheet.Hyperlinks.Add Anchor:=.Offset(j, 4), _
         Address:=linkNodes(i).Text, TextToDisplay:=titleNodes(i).Text

投稿日時: 23/02/03 11:02:32
投稿者: takatada72

ありがとうございました。
 
無事、解決しました。
 
ハイパーリンクの使い方は、記録させていただきたいと思います。