Sub MyRssSanspo()
Rem *----*----* *----*----* *----*----* *----*----*
Rem サンスポ（サンケイスポーツ）RSS取り込み処理
Rem 作譜：Hitrock Camellia Shinopy
Rem 言語：Excel VBA
Rem 機能...
Rem 指定したサイトのRSSを取り込みする。
Rem 注記...
Rem 1. MyRssSanspoを起動して実行。
Rem 2. 初回実行前に「myFile」に取り込むRSSデータの保存先を指定すること。
Rem 履歴...
Rem 第01版：2008/09/15：作成。
Rem *----*----* *----*----* *----*----* *----*----*
Dim myTitle As String
Dim myAns As Long
Dim myFlag As Boolean
Dim i As Long
Dim c As Long
Dim myMax As Long
Dim mySheetFirst As Long
'
Dim mySite As String
Dim mySiteArray As Variant
Dim mySheet As String
Dim mySheetArray As Variant
Dim myURL As Variant
Dim myText As String
Dim myStatusBar As String
'
Dim myHTTP As Variant ' IXMLHTTPRequest
Dim myStream As Variant ' Stream
Dim myFile As String
'
Dim myFileValue As Boolean
Dim myXmlDoc As Variant
Rem *----*----* *----*----* *----*----* *----*----*
'
myTitle = "MyRssSanspo"
myFile = "C:\Documents and Settings\User\My Documents\Zzz\MyRssSanspo.xml"
Call MyRssSanspoPopUp(myTitle)
'
Select Case CommandBars(myTitle).Controls(1).FaceId
Case 964: myAns = vbOK
Case 330: myAns = vbCancel
End Select
'
If CommandBars(myTitle).Controls(2).FaceId = 220 Then
myFlag = True
Else
myFlag = False
End If
'
If myAns = vbCancel Then GoTo MyRssSanspoSubExit
'
Call MyRssSanspoMySite(mySite, myFlag)
mySiteArray = Split(mySite, ",")
Call MyRssSanspoMySheet(mySheet)
mySheetArray = Split(mySheet, ",")
'
mySiteArray = Split(mySite, ",")
myMax = UBound(mySiteArray) + 1
Rem *----*----* *----*----* *----*----* *----*----*
'
myStatusBar = "サンケイスポーツRSS取り込み処理 開始！"
Application.StatusBar = "MyRssSanspo: " & myStatusBar
'
Application.CommandBars("Task Pane").Visible = False
Application.ScreenUpdating = False
Range("A1").Select
mySheetFirst = ActiveSheet.Index
'
c = Worksheets.Count - ActiveSheet.Index + 1
If c < myMax Then
c = myMax - c
For i = 1 To c
Worksheets.Add After:=Sheets(Worksheets.Count), Count:=1
Next ' i
Sheets(mySheetFirst).Activate
End If
Rem *----*----* *----*----* *----*----* *----*----*
'
Set myXmlDoc = CreateObject("MSXML2.DOMDocument")
Set myHTTP = CreateObject("Microsoft.XMLHTTP")
Set myStream = CreateObject("ADODB.Stream")
Rem *----*----* *----*----* *----*----* *----*----*
'
MyRssSanspoSubEntry:
c = 0
For Each myURL In mySiteArray
c = c + 1
myStatusBar = c * 100 \ myMax & "% " & c & "/" & myMax & "頁 "
Application.StatusBar = "MyRssSanspo" & "：" & myStatusBar
'
Columns("A:A").Select
With Selection
.ColumnWidth = 70
' .RowHeight = 19
.VerticalAlignment = xlTop
.WrapText = True
End With
Columns("B:B").Select
With Selection
.ColumnWidth = 50
.VerticalAlignment = xlTop
.WrapText = True
End With
Rem *----*----* *----*----*
'
Call myHTTP.Open("GET", myURL, False)
On Error Resume Next
myHTTP.Send
'
If Err.Number <> 0 Then
Range("A1").Value = Err.Number
Range("B1").Value = Err.Description
Else
Const AdBinary = 1
' Const AdTypeText = 2
Set myStream = CreateObject("ADODB.Stream")
myStream.Type = AdBinary
myStream.Open
myStream.write (myHTTP.responseBody)
myStream.Position = 0
myStream.Type = AdBinary
Call myStream.SaveToFile(myFile, 2) ' 上書き
myStream.Close
'
myXmlDoc.Async = False
myFileValue = myXmlDoc.Load(myFile)
'
If myFileValue = True Then
Call MyRssSanspoMyXmlDoc(myXmlDoc, myFile, mySheetArray)
Else
Range("A1").Value = "XMLファイルがありません！"
Range("B1").Value = myURL
End If
End If
On Error GoTo 0
Rem *----*----* *----*----*
'
Range("B1").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.Zoom = 80
On Error Resume Next
ActiveSheet.Next.Select
On Error GoTo 0
DoEvents
Next ' myURL
'
Sheets(mySheetFirst).Activate
Rem *----*----* *----*----* *----*----* *----*----*
'
MyRssSanspoSubExit:
Application.ScreenUpdating = True
On Error Resume Next
Kill myFile
On Error GoTo 0
myText = "処理が終了しました。"
Application.StatusBar = "MyRssSanspo: " & myText & " " & Now()
Application.Speech.Speak myText, False
End Sub ' MyRssSanspo *----*----* *----*----* *----*----* *----*----*
Sub MyRssSanspoMyXmlDoc(myXmlDoc As Variant, myFile As String, mySheetArray As Variant)
Dim myTitle As Variant
Dim myLink As Variant
Dim myDescript As Variant
Dim myDate As Variant
'
Dim i As Long
Dim myText As String
Dim myStatusBar As String
Rem *----*----* *----*----* *----*----* *----*----*
'
Set myTitle = myXmlDoc.selectNodes("//title")
Set myLink = myXmlDoc.selectNodes("//link")
Set myDescript = myXmlDoc.selectNodes("//description")
Set myDate = myXmlDoc.selectNodes("//pubDate")
Rem *----*----* *----*----* *----*----* *----*----*
'
For i = 1 To myTitle.Length
myStatusBar = Application.StatusBar
myStatusBar = Left(myStatusBar, InStr(myStatusBar, "頁 ") + 1)
myStatusBar = myStatusBar & i & "/" & myTitle.Length & "行"
Application.StatusBar = myStatusBar
'
Select Case i
Case 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=myLink(i - 1).Text, TextToDisplay:=myTitle(i - 1).Text & " " & myDescript(i - 1).Text
Cells(i, 1).RowHeight = 30
Cells(i + 1, 2).Value = myDate(i - 1).Text
Call MyRssSanspoSheetName(mySheetArray)
Case Else
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=myLink(i - 1).Text, TextToDisplay:=myTitle(i - 1).Text
Cells(i + 1, 2).Value = myDate(i - 1).Text
End Select
DoEvents
Next ' i
End Sub ' MyRssSanspoMyXmlDoc *----*----* *----*----* *----*----* *----*----*
Sub MyRssSanspoMySite(mySite As String, myFlag As Boolean)
If myFlag = False Then
mySite = "http://www.sanspo.com/rss/chumoku/news/allsports-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/chumoku/news/allentertainments-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/news/baseball-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/mlb/news/mlb-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/soccer/news/soccer-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/rugby/news/rugby-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/golf/news/golf-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/fight/news/fight-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/news/sports-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/keiba/news/keiba-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/shakai/news/shakai-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/geino/news/geino-n.xml"
Exit Sub
End If
'
mySite = "http://www.sanspo.com/rss/chumoku/news/allsports-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/chumoku/news/allentertainments-n.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/news/baseball-n.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absa.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absb.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absc.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absd.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-abse.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absf.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absg.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absh.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absi.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absj.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absk.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absl.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absm.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-absn.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/baseball/tokushu/baseball-abso.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/mlb/news/mlb-n.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/soccer/news/soccer-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/soccer/tokushu/soccer-asca.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/soccer/tokushu/soccer-ascb.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/soccer/tokushu/soccer-ascc.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/soccer/tokushu/soccer-ascd.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/rugby/news/rugby-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/rugby/tokushu/rugby-arga.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/rugby/tokushu/rugby-argb.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/rugby/tokushu/rugby-argd.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/golf/news/golf-n.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/fight/news/fight-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/fight/tokushu/fight-afga.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/fight/tokushu/fight-afgb.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/fight/tokushu/fight-afgc.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/news/sports-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspa.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspb.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspc.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspd.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspe.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspf.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspg.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-asph.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspi.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspj.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspk.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspl.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/sports/tokushu/sports-aspm.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/keiba/news/keiba-n.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/shakai/news/shakai-n.xml"
'
mySite = mySite & "," & "http://www.sanspo.com/rss/geino/news/geino-n.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/geino/tokushu/geino-agna.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/geino/tokushu/geino-agnb.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/geino/tokushu/geino-agnc.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/geino/tokushu/geino-agnd.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/geino/tokushu/geino-agnf.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/geino/tokushu/geino-agng.xml"
mySite = mySite & "," & "http://www.sanspo.com/rss/geino/tokushu/geino-agne.xml"
End Sub ' MyRssSanspoMySite *----*----* *----*----* *----*----* *----*----*
Sub MyRssSanspoMySheet(mySheet As String)
'
mySheet = "「スポーツ」総合ニュース"
mySheet = mySheet & "," & "「社会・芸能」総合ニュース"
'
mySheet = mySheet & "," & "「野球」最新ニュース"
mySheet = mySheet & "," & "「巨人」最新ニュース"
mySheet = mySheet & "," & "「阪神」最新ニュース"
mySheet = mySheet & "," & "「中日」最新ニュース"
mySheet = mySheet & "," & "「広島」最新ニュース"
mySheet = mySheet & "," & "「横浜」最新ニュース"
mySheet = mySheet & "," & "「ヤクルト」最新ニュース"
mySheet = mySheet & "," & "「西武」最新ニュース"
mySheet = mySheet & "," & "「楽天」最新ニュース"
mySheet = mySheet & "," & "「ロッテ」最新ニュース"
mySheet = mySheet & "," & "「日本ハム」最新ニュース"
mySheet = mySheet & "," & "「オリックス」最新ニュース"
mySheet = mySheet & "," & "「ソフトバンク」最新ニュース"
'
mySheet = mySheet & "," & "「高校野球」最新ニュース"
mySheet = mySheet & "," & "「大学野球」最新ニュース"
mySheet = mySheet & "," & "「アマ野球」最新ニュース"
mySheet = mySheet & "," & "「ＭＬＢ」最新ニュース"
'
mySheet = mySheet & "," & "「サッカー」最新ニュース"
mySheet = mySheet & "," & "「Jリーグ」最新ニュース"
mySheet = mySheet & "," & "「海外サッカー」最新ニュース"
mySheet = mySheet & "," & "「サッカー日本代表」最新ニュース"
mySheet = mySheet & "," & "「サッカー海外代表」最新ニュース"
'
mySheet = mySheet & "," & "「ラグビー」最新ニュース"
mySheet = mySheet & "," & "「トップリーグ」最新ニュース"
mySheet = mySheet & "," & "「大学ラグビー」最新ニュース"
mySheet = mySheet & "," & "「ラグビー日本代表」最新ニュース"
'
mySheet = mySheet & "," & "「ゴルフ」最新ニュース"
'
mySheet = mySheet & "," & "「ファイト」最新ニュース"
mySheet = mySheet & "," & "「プロレス」最新ニュース"
mySheet = mySheet & "," & "「ボクシング」最新ニュース"
mySheet = mySheet & "," & "「格闘技」最新ニュース"
'
mySheet = mySheet & "," & "「スポーツ」最新ニュース"
mySheet = mySheet & "," & "「Ｆ１」最新ニュース"
mySheet = mySheet & "," & "「Ｆニッポン」最新ニュース"
mySheet = mySheet & "," & "「ＮＢＡ」最新ニュース"
mySheet = mySheet & "," & "「ＮＦＬ」最新ニュース"
mySheet = mySheet & "," & "「ＮＨＬ」最新ニュース"
mySheet = mySheet & "," & "「相撲」最新ニュース"
mySheet = mySheet & "," & "「陸上」最新ニュース"
mySheet = mySheet & "," & "「水泳」最新ニュース"
mySheet = mySheet & "," & "「柔道」最新ニュース"
mySheet = mySheet & "," & "「卓球」最新ニュース"
mySheet = mySheet & "," & "「バレーボール」最新ニュース"
mySheet = mySheet & "," & "「テニス」最新ニュース"
mySheet = mySheet & "," & "「スケート」最新ニュース"
'
mySheet = mySheet & "," & "「競馬」最新ニュース"
'
mySheet = mySheet & "," & "「社会」最新ニュース"
'
mySheet = mySheet & "," & "「芸能」最新ニュース"
mySheet = mySheet & "," & "「熱愛」最新ニュース"
mySheet = mySheet & "," & "「結婚・出産」最新ニュース"
mySheet = mySheet & "," & "「離婚・破局」最新ニュース"
mySheet = mySheet & "," & "「事件・スキャンダル」最新ニュース"
mySheet = mySheet & "," & "「お笑い」最新ニュース"
mySheet = mySheet & "," & "「ジャニーズ」最新ニュース"
mySheet = mySheet & "," & "「宝塚」最新ニュース"
End Sub ' MyRssSanspoMySheet *----*----* *----*----* *----*----* *----*----*
Sub MyRssSanspoSheetName(mySheetArray As Variant)
Dim myName As String
Dim mySheet As Variant
Static myCategory As String
'
myName = Cells(1, 1).Text
'
For Each mySheet In mySheetArray
Select Case True
Case InStr(myName, mySheet) > 0
myName = mySheet
'
Exit For
End Select
Next ' mySheet
'
myName = Replace(myName, "ニュース", "")
myName = Replace(myName, "最新", "")
myName = Replace(myName, "「", "")
myName = Replace(myName, "」", " ")
ActiveSheet.Name = myName
End Sub ' MyRssSanspoSheetName *----*----* *----*----* *----*----* *----*----*
Sub MyRssSanspoPopUp(myTitle As String)
Rem *----*----* *----*----* *----*----* *----*----*
Rem ポップアップ表示処理
Rem *----*----* *----*----* *----*----* *----*----*
Dim myCmmdBar As CommandBar
Dim myCtrlBttnIcon As CommandBarControl
Dim myCtrlBttnDeTail As CommandBarControl
Dim myCtrlBttnOk As CommandBarControl
Dim myCtrlBttnCancel As CommandBarControl
Dim x As Long
Dim y As Long
Dim myFaceId As Long
Dim myMsg As String
'
On Error Resume Next
CommandBars(myTitle).Delete
On Error GoTo 0
'
Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarPopup, Temporary:=True)
Set myCtrlBttnIcon = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True)
Set myCtrlBttnDeTail = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True)
Set myCtrlBttnOk = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=3, Temporary:=True)
Set myCtrlBttnCancel = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=4, Temporary:=True)
'
myMsg = myTitle & vbCrLf
myMsg = myMsg & "サンケイスポーツRSS取り込み処理" & vbCrLf & vbCrLf
'
With myCtrlBttnIcon
.DescriptionText = "サンケイスポーツRSS取り込み処理ポップアップメニュー"
.Style = msoButtonIconAndWrapCaption
.Caption = myMsg & "処理を実行しますか？"
.TooltipText = "処理を実行しますか？"
.FaceId = 1089
myFaceId = .FaceId
.OnAction = "MyRssSanspoBttnMyIcon"
End With
'
With myCtrlBttnDeTail
.DescriptionText = "[詳細RSSも取り込む]ボタン"
.BeginGroup = True
.Style = msoButtonIconAndCaption
.Caption = "詳細RSSも取り込む"
.TooltipText = "詳細RSSは取り込まない。"
.FaceId = 6963
.OnAction = "MyRssSanspoBttnMyDetail"
End With
'
With myCtrlBttnOk
.DescriptionText = "[OK]ボタン"
.BeginGroup = True
.Style = msoButtonIconAndCaption
.Caption = "OK"
.TooltipText = "処理をを実行します。"
.FaceId = 964
.OnAction = "MyRssSanspoBttnMyOk"
End With
'
With myCtrlBttnCancel
.DescriptionText = "[キャンセル]ボタン"
.Style = msoButtonIconAndCaption
.Caption = "キャンセル" & String(13, " ")
.TooltipText = "処理を中止します。"
.FaceId = 330
.OnAction = "MyRssSanspoBttnMyCancel"
End With
Rem *----*----* *----*----* *----*----* *----*----*
'
x = -1: y = -1
myFaceId = myCmmdBar.Controls(1).FaceId
Beep
'
Do
On Error Resume Next
If x = -1 Then
myCmmdBar.ShowPopup
Else
myCmmdBar.ShowPopup x, y
End If
On Error GoTo 0
DoEvents
Select Case myCmmdBar.Controls(1).FaceId
Case 964, 330 ' 実行／キャンセル
Exit Do
Case 220, 6963, 1089 ' [チェックボックス]オン・オフ／[処理を実行しますか？]
x = myCmmdBar.Left
y = myCmmdBar.Top
myCmmdBar.Controls(1).FaceId = myFaceId
Case Else
x = -1: y = -1
End Select
Loop
End Sub ' MyRssSanspoPopUp *----*----* *----*----* *----*----* *----*----*
Sub MyRssSanspoBttnMyIcon(Optional MyDummy As Boolean)
Rem *----*----* *----*----* *----*----* *----*----*
Rem [処理を実行しますか？]ボタン処理
Rem *----*----* *----*----* *----*----* *----*----*
'
CommandBars("MyRssSanspo").Controls(1).FaceId = 1089
End Sub ' MyRssSanspoBttnMyIcon *----*----* *----*----* *----*----* *----*----*
Sub MyRssSanspoBttnMyDetail(Optional MyDummy As Boolean)
Rem *----*----* *----*----* *----*----* *----*----*
Rem [詳細RSSも取り込む]ボタン処理
Rem *----*----* *----*----* *----*----* *----*----*
'
With CommandBars("MyRssSanspo").Controls(2)
If .FaceId = 6963 Then
.FaceId = 220
.TooltipText = "詳細RSSも取り込む。"
Else
.FaceId = 6963
.TooltipText = "詳細RSSは取り込まない。"
End If
End With
CommandBars("MyRssSanspo").Controls(1).FaceId = CommandBars("MyRssSanspo").Controls(2).FaceId
End Sub ' MyRssSanspoBttnMyDetail *----*----* *----*----* *----*----* *----*----*
Sub MyRssSanspoBttnMyOk(Optional MyDummy As Boolean)
Rem *----*----* *----*----* *----*----* *----*----*
Rem コマンドボタン[OK]OnAction処理
Rem *----*----* *----*----* *----*----* *----*----*
'
CommandBars("MyRssSanspo").Controls(1).FaceId = 964
End Sub ' MyRssSanspoBttnMyOk *----*----* *----*----* *----*----* *----*----*
Sub MyRssSanspoBttnMyCancel(Optional MyDummy As Boolean)
Rem *----*----* *----*----* *----*----* *----*----*
Rem コマンドボタン[キャンセル]OnAction処理
Rem *----*----* *----*----* *----*----* *----*----*
'
CommandBars("MyRssSanspo").Controls(1).FaceId = 330
End Sub ' MyRssSanspoBttnMyCancel *----*----* *----*----* *----*----* *----*----*
