人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelで、指定したセルに画像や数値をHPから引っ張って来たいのですが、もし出来る方がおりましたらお願いします。

目的はその日の天気や気温をボタン一つでエクセル(日報等)に記入したいのです。
下記のHPで言えば左側のお天気マークや最高気温をボタン一つで表示させたいのですが。
http://weather.livedoor.com/area/20/72.html

HPの方は上記以外でも構いません。
天気と気温があれば良いです。

よろしくお願いします。

●質問者: bakuto
●カテゴリ:コンピュータ インターネット
✍キーワード:Excel エクセル セル ボタン マーク
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● SALINGER
●50ポイント

HTMLソースを取得して天気と気温を取得するVBAです。

ただし、IE6以下での方法です。(IE7の場合はちょっと変わります)

Sub Macro()
 Dim ieo As Object
 Dim txt As String
 Dim pos As Long
 Dim pos2 As Long
 Dim tenki As String
 Dim kion As String
 
 Set ieo = CreateObject("InternetExplorer.Application")
 ieo.Visible = False
 ieo.NaviGate "http://weather.livedoor.com/area/20/72.html"

 Do Until ieo.Busy = False
 Application.Wait Now + TimeValue("00:00:01")
 Loop
 
 txt = ieo.Document.Body.InnerHtml
 pos = InStr(InStr(1, txt, "今日の天気", vbTextCompare), txt, "<small>", vbTextCompare) + 7
 pos2 = InStr(pos, txt, "<")
 tenki = Mid(txt, pos, pos2 - pos)
 pos = InStr(InStr(pos, txt, "最高気温", vbTextCompare), txt, "<small>", vbTextCompare) + 7
 pos2 = InStr(pos, txt, "<")
 kion = Mid(txt, pos, pos2 - pos)
 
 MsgBox "今日の天気 : " & tenki & vbCrLf & "最高気温 : " & kion
 
 Set ieo = Nothing
End Sub

コードをボタンに貼り付けたり、変数tenki と kion にそれぞれ代入されるので、

それをシートのセルに表示したり、天気で条件分岐してアイコンを表示するなどいろいろできると思います。

◎質問者からの返答

ブラボー!!

早速、挑戦してみます。

結果はコメント欄で。


2 ● SALINGER
●200ポイント ベストアンサー

説明不足で申し訳ありませんでした。

前に回答したものはインターネットからソースを取得してメッセージボックスに表示する基本的な部分だけでした。

まず、シートにコマンドボタンをつけるには以下のような感じです。

http://sigoto.co.jp/excel/activex/lesson07/activex2.htm

同時に画像を表示させるためのイメージをシート上の好きなところに配置します。(名前はそのままImage1です)

ボタンを押したときにコードが実行されるようにするには、ボタンをダブルクリックして開くところに以下のコードをコピペします。


そして天気の画像をエクセルのブックと同じところに用意します。

画像は1?30まで次のところにあります

http://image.weather.livedoor.com/img/icon/1.gif


Private Sub CommandButton1_Click()
 Dim ieo As Object
 Dim txt As String
 Dim pos As Long
 Dim pos2 As Long
 Dim tenki As String
 Dim kion As String
 Dim sp As Shape
 
  'IEオブジェクトの取得
 Set ieo = CreateObject("InternetExplorer.Application")
 ieo.Visible = False
 
  'ホームページを指定します
 ieo.NaviGate "http://weather.livedoor.com/area/20/72.html"

  '読みこまれるまでループさせます
 Do Until ieo.Busy = False
 Application.Wait Now + TimeValue("00:00:01")
 Loop
 
  'HTMLソースを取得します
 txt = ieo.Document.Body.InnerHtml
 
  '取得したソースから天気と最高気温を探します。
  'この部分はホームページの変更によってうまく動作しなくなることがあります。
 pos = InStr(InStr(1, txt, "今日の天気", vbTextCompare), txt, "<small>", vbTextCompare) + 7
 pos2 = InStr(pos, txt, "<")
 tenki = Mid(txt, pos, pos2 - pos)
 pos = InStr(InStr(pos, txt, "最高気温", vbTextCompare), txt, "<small>", vbTextCompare) + 7
 pos2 = InStr(pos, txt, "<")
 kion = Mid(txt, pos, pos2 - pos)
 
  'イメージの大きさを画像の大きさに合わせます
 Image1.AutoSize = True
 
  '以下は天気によって条件分岐して画像を表示するところです
  '2つの場合しか作っていませんが30個必要になります。
 Select Case tenki
 Case "晴れ"
 Image1.Picture = LoadPicture(ThisWorkbook.Path & "\1.gif")
 
 Case "曇時々雨"
 Image1.Picture = LoadPicture(ThisWorkbook.Path & "\10.gif")
 End Select
 
  '最高気温をA1セルに表示
 Range("A1").Value = kion
 
 Set ieo = Nothing
End Sub

ボタンを押すと、最高気温をA1セルに、天気を貼り付けたイメージに表示します。

◎質問者からの返答

早速挑戦しました。うまく行きませんでした。


コマンドボタンを作りそこにコードはコピーしました。


>天気の画像をエクセルのブックと同じところに用意します。

これは同じ「フォルダ」に入れると言う意味で良いのですか?

とりあえず画像(30個)とエクセルファイルを同じフォルダに入れて回したところ、「実行時エラー'424' オブジェクトが必要です」と表示され

て、デバックを選択するとImage1.AutoSize = Trueの部分が黄色で表示されます。


私レベルでは原因が何か皆目検討もつかないので、すみませんが再回答の方よろしくお願いします。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ