VBA google画像検索 画像表示

Question

エクセルのVBAで文字列に対する画像が表示されるマクロを作成したいです。

やりたいこととして例えば、
A列に５つワードが書かれており、
そのワードをひとつずつgoogleで画像検索し、検索結果から画像１つを
A列の文字列の横に表示する。ということです。

ブラウザを開いてワード検索するところまで書いたのですが、それ以降の処理がわかりません。
教えていただきたいです、よろしくお願いいたします。

Private Sub GoogleSearch()

Dim objIE As Object

Set objIE = CreateObject(“InternetExplorer.Application”)
objIE.Visible = True

objIE.navigate “http://www.google.co.jp/”

Sleep (1500)

Call IeWait(objIE)

objIE.document.forms(0).Item(“q”).Value = “チョコレート”

Sleep (1000)

objIE.document.getElementById(“gbqfb”).Click

‘objIE.Quit
‘Set objIE = Nothing

End Sub

ーーーーーーーー
整理のため、今一度コードを現在のコードを記載します。
※htsignさんより回答いただき、下記のように編集いたしました。

Option Explicit

Private Sub Main()
    Call GoogleSearch(ActiveCell.Value2)
End Sub

Private Sub GoogleSearch(ByVal query As String)
    Dim html As String
    html = FetchHtml("https://www.google.co.jp/search?tbm=isch&q=" & query)
    
    Dim nextUrl As String
    nextUrl = FindFirstUrlFromGoogleImageSearch(html)
    
    DownloadFileToTempDir nextUrl
    
    AddPicture
End Sub

Private Function FetchHtml(ByVal url As String) As String
    Dim xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    
    xhr.Open "GET", url, True
    xhr.send
    
    Do Until xhr.readyState = 4
        DoEvents
    Loop
    
    FetchHtml = xhr.responseText
    
    Set xhr = Nothing
End Function

Private Sub DownloadFileToTempDir(ByVal url As String)
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    
    Dim xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    
    xhr.Open "GET", url, True
    xhr.setRequestHeader "Pragma", "no-cache"
    xhr.setRequestHeader "Cache-Control", "no-cache"
    xhr.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
    xhr.send
    
    Do Until xhr.readyState = 4
        DoEvents
    Loop
    
    With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write xhr.responseBody
        .SaveToFile Environ("TEMP") & "\vbatemp", adSaveCreateOverWrite
        .Close
    End With
End Sub

Private Function FindFirstUrlFromGoogleImageSearch(ByVal html As String) As String
    Dim partOfHtml As String
    Dim idx As Long
    
    idx = InStr(html, "imgurl=")
    partOfHtml = Mid(html, idx + 7)
    idx = InStr(partOfHtml, "&")
    
    FindFirstUrlFromGoogleImageSearch = Left(partOfHtml, idx - 1)
End Function

Private Sub AddPicture()
    Dim shape As shape
        Set shape = ActiveSheet.Shapes.AddPicture( _
        Filename:=Environ("TEMP") & "\vbatemp", _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Left:=ActiveCell.Left + ActiveCell.Width, _
        Top:=ActiveCell.Top, _
        Width:=0, _
        Height:=0)
    
    shape.ScaleHeight 1, msoTrue
    shape.ScaleWidth 1, msoTrue
    
    Set shape = Nothing

End Sub

Answer 1

検索クエリの入ったセルを選択（複数選択可）した状態でMainプロシージャを実行すれば、選択済みのすべてのセルの右隣に、クエリで検索して見つかった1つ目の画像を貼り付けます。

'Option Explicitは宣言されていない変数を認めないようにするための特殊な宣言です。
'これがないといきなり新しい変数を作ることができるようになるため、手軽な反面ミスタイプに気づきにくくなります。
Option Explicit

'ここが起点になります。
Private Sub Main()
    Dim cell As Range
    'Selection とは選択範囲を表す特殊なオブジェクトです。
    'このオブジェクトはセルを選択していればRangeオブジェクトになるし、
    '画像を選択していればShapeオブジェクトになるなど、実行時まで型が判別できません。
    'For Each ~ Nextは範囲を持ったオブジェクト（配列や連想配列など）をすべて舐めるための構文です。
    'Excel VBAにおいてはRangeオブジェクトにも使えるため、このようにしています。
    For Each cell In Selection
        Call GoogleSearch(cell)
    Next
End Sub

'Google画像検索して貼り付けるまでの一連の流れを取りまとめるためのプロシージャです。
Private Sub GoogleSearch(ByRef cell As Range)
    Dim query As String
    'セルに含まれる値を取り出し、文字列型にします。数字や時刻であっても文字列になります。
    query = CStr(cell.Value2)
    
    Dim html As String
    '指定のURLにアクセスして、サーバから返ってくるHTMLをテキストで取得します。
    html = FetchHtml("https://www.google.co.jp/search?tbm=isch&q=" & query)
    
    Dim nextUrl As String
    'HTMLテキストを探索して、最初に見つかる画像URLを取り出します。
    nextUrl = FindFirstUrlFromGoogleImageSearch(html)
    
    '上で得た画像URLにアクセスし、ファイルをダウンロードして一時フォルダに保存します。
    DownloadFileToTempDir nextUrl
    
    '一時フォルダに保存された画像をシートに貼り付けます。
    AddPicture cell
End Sub

'変数[url]にアクセスしてHTMLをテキストで返します。
Private Function FetchHtml(ByVal url As String) As String
    'JavaScriptではXMLHttpRequestと呼ばれるオブジェクトです。
    Dim xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    
    'GETリクエストを非同期で要求するよう接続をオープンします。
    xhr.Open "GET", url, True
    '要求を送信します。
    xhr.send
    
    'Do (While|Until) ~ Loopは与えられた条件が成り立っている間、あるいは成り立つまで繰り返します。
    Do Until xhr.readyState = 4
        'DoEventsはウィンドウメッセージを処理させる命令です。
        '待機中、画面が応答なしになるのを防ぐ、くらいに思っておけばいいでしょう。
        DoEvents
    Loop
    
    '応答結果を返り値に設定します。
    FetchHtml = xhr.responseText
    
    'オブジェクト解放
    Set xhr = Nothing
End Function

Private Sub DownloadFileToTempDir(ByVal url As String)
    'ref: http://www.ka-net.org/blog/?p=4855
    
    '定数宣言です。
    '定数とは、変数と違って一度定義したら変えられない特殊な変数のようなものです。
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    
    Dim xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    
    xhr.Open "GET", url, True
    'HTTPヘッダを設定します。詳しくはネットワーク系の基礎を勉強してください。
    xhr.setRequestHeader "Pragma", "no-cache"
    xhr.setRequestHeader "Cache-Control", "no-cache"
    xhr.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
    xhr.send
    
    Do Until xhr.readyState = 4
        DoEvents
    Loop
    
    'ADODB.Streamはデータストリームを汎用的に扱うためのAPI群を提供します。
    With CreateObject("ADODB.Stream")
        '保存するものは画像なので、扱うデータはバイナリであることを設定しています。
        'ファイルをメモ帳で開いて文字化けしていなかったら「テキスト」、それ以外はすべて「バイナリ」くらいの認識でいいです。
        .Type = adTypeBinary
        'ストリームをオープンします。
        .Open
        'ストリームにデータを書き込みます。中身はバイナリなので人間には読めません。
        .Write xhr.responseBody
        'ストリームの中身をファイルに出力します。
        .SaveToFile Environ("TEMP") & "\vbatemp", adSaveCreateOverWrite
        'ストリームを閉じます。
        .Close
    End With
    
    'オブジェクト解放
    Set xhr = Nothing
End Sub

'HTMLテキストから最初に見つかる画像URLを返します。
Private Function FindFirstUrlFromGoogleImageSearch(ByVal html As String) As String
    Dim partOfHtml As String
    'Long型は32bit長のビットで表せる整数です。VB.NETでのLong（こちらは64bit）とは別物です。
    Dim idx As Long
    
    'HTMLソースの何文字目に "imgurl=" という文字列が含まれるのかを idx に格納します。
    idx = InStr(html, "imgurl=")
    'idx + 7 番目から後の文字列を抽出します。
    partOfHtml = Mid(html, idx + 7)
    '抽出後の文字列の何番目に "&" という文字列が含まれるのかを idx に格納します。
    idx = InStr(partOfHtml, "&")
    
    '最初から idx - 1 番目までを抽出して、返り値に設定します。
    FindFirstUrlFromGoogleImageSearch = Left(partOfHtml, idx - 1)
End Function

'与えられたRange型（セル）の右隣に、あらかじめ保存された画像を貼り付けます。
Private Sub AddPicture(ByRef cell As Range)
    Dim shape As shape
    'ここの詳しいパラメータの機能は私もよくは知りません。
    Set shape = ActiveSheet.Shapes.AddPicture( _
        Filename:=Environ("TEMP") & "\vbatemp", _
        'Excelでの画像貼り付けには複数の方法があり、
        'ファイルへのリンクとするのかExcelファイル自体に画像を含ませるのかを選択できます。
        'ここではExcelファイルに埋め込んでいます。
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        'シートのA1の左上隅を頂点として、右にどのくらいずらすのかを指定します。
        Left:=cell.Left + cell.width, _
        'シートのA1の左上隅を頂点として、下にどのくらいずらすのかを指定します。
        Top:=cell.Top, _
        '貼り付ける画像の縦幅、横幅を指定します。
        'ここでは両方とも 0 に指定していますが、下でさらに別の設定をしています。
        width:=0, _
        height:=0)
    
    '貼り付けられた画像の縦幅横幅を、画像そのものの大きさに一致するようにします。
    shape.ScaleHeight 1, msoTrue
    shape.ScaleWidth 1, msoTrue
    
    'オブジェクト解放
    Set shape = Nothing
End Sub

Comments

[ttt1212]

本当にありがとうございます！感謝です。

この後、画像のサイズ変更を行いたいので、

どこで何をしているのか簡単に書いていただけると嬉しいです。

本当に本当にありがとうございます>_<

[htsign]

コメントを付けました。これでもかというくらい付けました。
これでも分からないことがあれば、あなたの勉強のためにもご自分で調べてみることをお勧めします。
大体の場合は、例えばWith句の意味を知りたいのであれば、
Googleで [excel vba with] を検索すれば知りたいことは分かるでしょう。

[ttt1212]

お返事遅れてすいません。
無事実装でいました。本当にありがとうございました。
自分ももっとプログラミング力つけるよう、精進していきます。
ありがとうございました。感謝です。

[htsign]

お役に立てて光栄です。
kukiさんのスキル向上を応援しています。

Answer 2

※コメント欄が長くなりすぎたため新たに回答させていただきます。

コードを拝見しました。

Set shape = ActiveSheet.Shapes.AddPicture( _
 Filename:=Environ("TEMP") & "\vbatemp" _
 LinkToFile:=False, _
 SaveWithDocument:=True, _
 Left:=ActiveCell.Left + ActiveCell.Width, _
 Top:=ActiveCell.Top, _
 Width:=0, _
 Height:=0)

ここでやはり「,」が抜けていますね。
お分かりになりますでしょうか。2行目は

  Filename:=Environ("TEMP") & "\vbatemp", _

とならなければならないはずです。
この文を1行で書いてみると分かるかと思います。

Set shape = ActiveSheet.Shapes.AddPicture(Filename:=Environ("TEMP") & "\vbatemp" LinkToFile:=False, SaveWithDocument:=True, Left:=ActiveCell.Left + ActiveCell.Width, Top:=ActiveCell.Top, Width:=0, Height:=0)

と書くことと等価です。Filenameのところが如何に異質かハッキリするでしょう。
「,」は引数はここからここまでです、とパーサ（プログラムの構文を解析する仕組み）に伝える役割を持ちます。
これを抜くとやれ「引数の数が少ない」だの「引数の型が違います」だの言われることになりますので、慣れないうちは注意して書くことが肝要です。

Comments

[ttt1212]

回答ありがとうございます。
カンマ外れていました、、すいません。
Filename:=Environ("TEMP") & "\vbatemp", _と、パラメータにはしっかりカンマつけました。
しかしまだ、同じところ（Private Sub AddPicture()）でエラーが起きてしまいます。

[htsign]

私の環境でもそのコードを張り付けて実行してみましたが問題なく最後までは知りました。
推測になりますが、もしかして DownloadFileToTempDir プロシージャ内の保存先が元のままなのではないでしょうか。
Filename:= にくるファイルパスにファイルが存在しないとエラーの原因になります。
DownloadFileToTempDir で保存しているファイルを本当に参照していますか？今一度確認してみてください。

[ttt1212]

DownloadFileToTempDir プロシージャ内の保存先ですが、
Private Sub AddPicture()の部分と同様のファイルを指定してあります。
.SaveToFile Environ("TEMP") & "\vbatemp", adSaveCreateOverWrite
これではダメなのでしょうか。。

[htsign]

> ちなみに、Filename:=の部分に存在するフォルダを指定すると、フォルダ内の画像が表示されます。
とおっしゃっていましたね。
つまりAddPictureプロシージャ自体には問題ないと推察できます。
となるとやはり保存時に問題があるとしか…。
AddPictureの段階でFilepath:= に指定されたパスの先にファイルは存在していますか？
ブレークポイントを置いて、AddPictureで止めた状態でエクスプローラから確認してみてください。

[ttt1212]

Environ("TEMP") & "\vbatemp", _
こちらのTEMPフォルダのことでしょうか。
Environの指定先の意味がわからないので、合っているかわからないのですが、
tempフォルダ自体はC:\tempと、ローカルディスクCの中のみ存在しております。

[ttt1212]

ファイルの存在ですが、
tempフォルダにファイルは存在しておりません。

[htsign]

通常、Windowsのテンポラリフォルダは全ユーザー共通のものと各ユーザー別々のものと2種類存在し、ほとんどのプログラムはユーザー別の方のテンポラリフォルダを利用します。
パスですが、確認する方法はあります。
https://my.pcloud.com/publink/show?code=XZYrbXZLuI8AL9hDvuyKHknX5H8vbcYtwPX
このように、該当箇所をウォッチ式に追加してやればよいです。

[ttt1212]

テンポラリフォルダの場所確認できました。
しかし、フォルダ先には”vbetemp”はありません。

[htsign]

ファイルがないということはやはり保存できていないのでしょうね…。
.SaveToFile 付近でブレイクして問題がないかを確認してみてほしいのですが…何が問題かが分からないとなるとちょっと難しいですね。

[ttt1212]

一度、ダウンロードの部分までに区切って、保存先をC:\フォルダ名にしながら、いろいろ試しています。
先ほど、私の質問文の部分を更新して、
今書いてあるコードを記載したのですが、このコードでhtsignさんの方で実行するとエラーでますでしょうか？
すいません、ご確認よろしくお願いいたします。

[htsign]

コード拝見しました。
問題なく実行され、シートに画像が貼り付けられるところまで確認しました。
…となると尚更分からなくなりましたね…。
違いとなるとマクロの定義箇所でしょうか。

私はシート（デフォルト名:Sheet1）に定義しています。
確かkukiさんはモジュールに定義していらっしゃったのでは？そこくらいしか違いが分かりません。

[ttt1212]

そうなのですね･･･
ほかにエクセル上でマクロは知らせる前に設定しなくてはならないものはありますでしょうか＞＜
エクセルシートには今のところ、A列に文字列が入っているだけです。

[ttt1212]

画像表示されました！！！
A１の文字列に対してだけですが。

A列に文字列が存在するまで上から繰り返し画像表示させるのは、
全体の構文にループをかければよいのでしょうか？

[htsign]

そうですね。
Dim cell As Range
For Each cell In Selection
GoogleSearch cell.Value2
Next
とすると選択しているセルすべてについて処理します。

[htsign]

失礼しました。
これだとエラーになりますね…。
ActiveCellと書かれている場所で画像を張り付ける場所を指定しています。ここを適宜切り替える必要があります。

[ttt1212]

ご返答ありがとうございます。
ActiveCellの部分を切り替えるについてですが、
AddPictureプロシージャの部分のActiveCellを
一回作業した-1するというfor文をつくればよいのでしょうか。

[ttt1212]

最後のプロシージャに
Dim cell As Range
For Each cell In Selection
GoogleSearch cell.Value2
Next
を追加すると、無限に１つ目のセル画像が表示されます。
一つずつ下に移動したいです･･･

[htsign]

返事が遅れました。すみません。
GoogleSearchプロシージャに渡す引数を変えるところから書いた方がいいかもしれません。
新規に回答を立ててコード全文を載せます。

[ttt1212]

本当にありがとうございます！感謝です。
この後、画像のサイズ変更も行いたいので、
どこで何をしているのか簡単に書いていただけると嬉しいです。
本当に本当にありがとうございます>_<

Answer 3

前提条件として、ワークブックが既に保存されている必要があります。（ActiveWorkbook.Pathを参照するため）
実装はかなり投げやりです。サーバが401や403を返す場合などは想定していません。
Excel 2013で動作確認しました。

Option Explicit

Private Sub Main()
    Call GoogleSearch(ActiveCell.Value2)
End Sub

Private Sub GoogleSearch(ByVal query As String)
    Dim html As String
    html = FetchHtml("https://www.google.co.jp/search?tbm=isch&q=" & query)
    
    Dim nextUrl As String
    nextUrl = FindFirstUrlFromGoogleImageSearch(html)
    
    DownloadFileToTempDir nextUrl
    
    AddPicture
End Sub

Private Function FetchHtml(ByVal url As String) As String
    Dim xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    
    xhr.Open "GET", url, True
    xhr.send
    
    Do Until xhr.readyState = 4
        DoEvents
    Loop
    
    FetchHtml = xhr.responseText
    
    Set xhr = Nothing
End Function

Private Sub DownloadFileToTempDir(ByVal url As String)
    'ref: http://www.ka-net.org/blog/?p=4855
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    
    Dim xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    
    xhr.Open "GET", url, True
    xhr.setRequestHeader "Pragma", "no-cache"
    xhr.setRequestHeader "Cache-Control", "no-cache"
    xhr.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
    xhr.send
    
    Do Until xhr.readyState = 4
        DoEvents
    Loop
    
    With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write xhr.responseBody
        .SaveToFile ActiveWorkbook.Path & "\vbatemp", adSaveCreateOverWrite
        .Close
    End With
End Sub

Private Function FindFirstUrlFromGoogleImageSearch(ByVal html As String) As String
    Dim partOfHtml As String
    Dim idx As Long
    
    idx = InStr(html, "imgurl=")
    partOfHtml = Mid(html, idx + 7)
    idx = InStr(partOfHtml, "&")
    
    FindFirstUrlFromGoogleImageSearch = Left(partOfHtml, idx - 1)
End Function

Private Sub AddPicture()
    'ref: http://www.moug.net/tech/exvba/0120020.html
    Dim shape As shape
    Set shape = ActiveSheet.Shapes.AddPicture( _
        Filename:=ActiveWorkbook.Path & "\vbatemp", _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Left:=ActiveCell.Left + ActiveCell.width, _
        Top:=ActiveCell.Top, _
        width:=0, _
        height:=0)
    
    shape.ScaleHeight 1, msoTrue
    shape.ScaleWidth 1, msoTrue
    
    Set shape = Nothing
End Sub

Comments

[ttt1212]

ご回答ありがとうございます。
ワークブックを保存できていないせいか、宣言が間違えているせいか、
構文エラーになってしまいます。
ちなみにワークブックの保存はデスクトップに"aa.bas"という名前で保存しました。
拡張子がおかしいのでしょうか･･･
あとプログラムのほうには、 "\vbatemp"の部分にワークブック名aa.basを入力しました。
申し訳ないですが、対処方法を教えていただけないでしょうか。
よろしくお願いいたします。

Private Sub AddPicture()
'ref: http://www.moug.net/tech/exvba/0120020.html
Dim shape As shape
Set shape = ActiveSheet.Shapes.AddPicture( _
Filename:=ActiveWorkbook.Path & "aa.bas",
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=ActiveCell.Left + ActiveCell.Width, _
Top:=ActiveCell.Top, _
Width:=0, _
Height:=0)

[ttt1212]

再び、すいません。
画像は取り込めたようなのですが、エクセルに表示される画像が非表示になってしまいます。
画像の非表示を対処するにはどうしたらよいのでしょう。。

[ttt1212]

ちなみに、使っているエクセルのバージョンはExcel2013です。

[htsign]

お返事遅れました。
どのように「取り込めたよう」と判断なされたのでしょうか。

また、画像が非表示というのは左上に「×」が表示されている状況ですか？
それですと取り込みに失敗しています。

> Filename:=ActiveWorkbook.Path & "aa.bas",
これは構文エラーですね。行末に _ がなければ動きません。
また、"aa.bas"と書かれていますが、 ActiveWorkbook.Path は 「\」を含まないため文字列の方に追加していました。
どうしてもファイル名だけになさりたいのであれば、
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
とした上で、
Filename:=fso.BuildPath(ActiveWorkbook.Path, "aa.bas"), _
などとするとよいかと思います。

恐縮ながら私のスクリプトを例に上げますと、DownloadFileToTempDirプロシージャで一時的に保存したファイルをAddPictureプロシージャでシートに張り付けています。
そのため、上記二つのプロシージャ内のファイル名は完全に一致する必要があります。
このファイルの中身は画像ファイルのバイナリデータとなるため、ファイル名はなんでも構わないはずです。拡張子さえも不要です。「vbatemp」と特に意味もなくつけたのはそういったためです。

[htsign]

連レス失礼します。
DownloadFileToTempDirというプロシージャ名は、当初保存ファイルのパスを
Environ("TEMP") & "\vbatemp"
としていたためでした。「Environ("TEMP")」でテンポラリフォルダを指します。
デバッグ目的でワークブックと同じフォルダに保存するようにしましたが、プロシージャ名を変えるのを忘れていましたね…。

[ttt1212]

お返事ありがとうございます！
画像はやはり取り込めていなかったようです。
「vbatemp」は特に編集しなくてよかったのですね。
filenameの指定は「vbatemp」に直しました。

記入していただいたスクリプトをそのまま実行すると、
AddPictureプロシージャの部分でアプリケーション定義またはオブジェクト定義のエラーが出てしまいます。

すいません、修正方法を教えていただけないでしょうか。

[ttt1212]

DownloadFileToTempDirというプロシージャ名は、当初保存ファイルのパスを
Environ("TEMP") & "\vbatemp"
としていたためでした。「Environ("TEMP")」でテンポラリフォルダを指します。
＞ということは、
つまりどのようにすればよいのでしょう･･･。
AddPictureプロシージャの
Filename:=ActiveWorkbook.Path & "\vbatemp", _
ここの部分をFilename:=Environ("TEMP")
とするのでしょうか？

[htsign]

> Filename:=Environ("TEMP")
これだけですと、フォルダパスにファイルを書き込もうとしてエラーになります。
何らかのファイル名を指定する必要があります。
例えば Filename:=Environ("TEMP") & "\vbatemp" などです。

失礼ながら、kukiさんはVBAのデバッグをなさったことがあまりないのでしょうか。
Alt+F11で表示される画面で、F8キーを押すとコードのステップ実行ができます。
これで一つずつ順に進めていけばどこがエラーの原因になっているのかを特定できるはずです。

また、コードの左側の空間をクリックすると赤色の「●」がつくと思います。
ブレークポイントと呼ばれるこれは、エラーがなくても処理がそこでストップします。
止まった状態で変数の中身を見たりコードを書き換えたりできますので、マクロを書くのであれば使いこなせると便利です。

「アプリケーション定義またはオブジェクト定義のエラー」は、というかVBAのエラーは一つ一つのエラー文言が非常にあいまいで原因特定の足掛かりとしては弱いのが特徴です。
正直なところ、それだけでは何が原因かというのはこちらから申し上げるのは難しいです。

[ttt1212]

VBAを使うのにあまりなれていないものも申し訳ございません。
ファイル名を Filename:=Environ("TEMP") & "\vbatemp" にして、
書き直しました。
DownloadFileToTempDirプロシージャのFilenameは
.SaveToFile ActiveWorkbook.Path & "\vbatemp", adSaveCreateOverWrite
AddPictureプロシージャはFilename:=Environ("TEMP") & "\vbatemp"
としてあります。
デバックしたところ、Set shapeからエラーが出ています。
Private Sub AddPicture()
'ref: http://www.moug.net/tech/exvba/0120020.html
Dim shape As shape
Set shape = ActiveSheet.Shapes.AddPicture( _
Filename:=Environ("TEMP") & "\vbatemp" _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=ActiveCell.Left + ActiveCell.Width, _
Top:=ActiveCell.Top, _
Width:=0, _
Height:=0)

[ttt1212]

Private Sub AddPicture()
'ref: http://www.moug.net/tech/exvba/0120020.html
Dim shape As shape
Set shape = ActiveSheet.Shapes.AddPicture( _
Filename:=Environ("TEMP") & "\vbatemp" _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=ActiveCell.Left + ActiveCell.Width, _
Top:=ActiveCell.Top, _
Width:=0, _
Height:=0)
※Heightの部分で黄色い矢印がでております。

[htsign]

パラメータは「,」で区切ってください。
「_」はあくまで「次の行にも同じ命令が続きますよ」という目印みたいなものなので、処理内容には影響してきません。

あと、これはマナーの問題ですが、別質問トピックを立てたのであればそちらに誘導するなりしてください。

[ttt1212]

マナーの件、申し訳ございません。
なかなか解決できなかったため、再び質問してしまいました。
後に立てたトピックは削除いたします。今後気をつけます。

パラメータを「,」で区切りました。
しかし、まだエラーが消えません。
LinkToFile:=False, _の部分に色がつきます。　
こちらの指定がエラーを起こしているのでしょうか。

[htsign]

あぁ、いえ。削除しろと申しているのではありません。
あなたに悪意がないことも分かっているつもりですので、今後気を付けていただければそれで十分ですよ。

一度動く状態まで持って行っていただいて、少しずつコードを書き換えるのは難しいですか？
私のコードは一応画像が取得できてセルの右隣に表示できるところまで確認しています。
一度動くことを確認して、その後保存場所を変えたり、そういったことはできませんか？

[ttt1212]

動く状態までもっていきたいのですが、Private Sub AddPicture()のエラーが出てしまい、先に進みません･･･
ちなみに、Filename:=の部分に存在するフォルダを指定すると、フォルダ内の画像が表示されます。

[ttt1212]

見づらいですが、今一度、コードを記入いたします。
Private Sub DownloadFileToTempDir(ByVal url As String)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2

Dim xhr As Object
Set xhr = CreateObject("MSXML2.XMLHTTP")

xhr.Open "GET", url, True
xhr.setRequestHeader "Pragma", "no-cache"
xhr.setRequestHeader "Cache-Control", "no-cache"
xhr.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
xhr.send

Do Until xhr.readyState = 4
DoEvents
Loop

With CreateObject("ADODB.Stream")
.Type = adTypeBinary
.Open
.Write xhr.responseBody
.SaveToFile ActiveWorkbook.Path & "\vbatemp", adSaveCreateOverWrite
.Close
End With
End Sub

Private Function FindFirstUrlFromGoogleImageSearch(ByVal html As String) As String
Dim partOfHtml As String
Dim idx As Long

idx = InStr(html, "imgurl=")
partOfHtml = Mid(html, idx + 7)
idx = InStr(partOfHtml, "&amp;")

FindFirstUrlFromGoogleImageSearch = Left(partOfHtml, idx - 1)
End Function

Private Sub AddPicture()
Dim shape As shape
Set shape = ActiveSheet.Shapes.AddPicture( _
Filename:=Environ("TEMP") & "\vbatemp" _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=ActiveCell.Left + ActiveCell.Width, _
Top:=ActiveCell.Top, _
Width:=0, _
Height:=0)

shape.ScaleHeight 1, msoTrue
shape.ScaleWidth 1, msoTrue

Set shape = Nothing

End Sub