回答編集履歴
1
コメントを大量に付与＆一部コード修正
test
CHANGED
|
@@ -2,14 +2,30 @@
|
|
|
2
2
|
|
|
3
3
|
```lang-vbscript
|
|
4
4
|
|
|
5
|
+
'Option Explicitは宣言されていない変数を認めないようにするための特殊な宣言です。
|
|
6
|
+
|
|
7
|
+
'これがないといきなり新しい変数を作ることができるようになるため、手軽な反面ミスタイプに気づきにくくなります。
|
|
8
|
+
|
|
5
9
|
Option Explicit
|
|
6
10
|
|
|
7
11
|
|
|
8
12
|
|
|
13
|
+
'ここが起点になります。
|
|
14
|
+
|
|
9
15
|
Private Sub Main()
|
|
10
16
|
|
|
11
17
|
Dim cell As Range
|
|
12
18
|
|
|
19
|
+
'Selection とは選択範囲を表す特殊なオブジェクトです。
|
|
20
|
+
|
|
21
|
+
'このオブジェクトはセルを選択していればRangeオブジェクトになるし、
|
|
22
|
+
|
|
23
|
+
'画像を選択していればShapeオブジェクトになるなど、実行時まで型が判別できません。
|
|
24
|
+
|
|
25
|
+
'For Each ~ Nextは範囲を持ったオブジェクト（配列や連想配列など）をすべて舐めるための構文です。
|
|
26
|
+
|
|
27
|
+
'Excel VBAにおいてはRangeオブジェクトにも使えるため、このようにしています。
|
|
28
|
+
|
|
13
29
|
For Each cell In Selection
|
|
14
30
|
|
|
15
31
|
Call GoogleSearch(cell)
|
|
@@ -20,62 +36,92 @@
|
|
|
20
36
|
|
|
21
37
|
|
|
22
38
|
|
|
39
|
+
'Google画像検索して貼り付けるまでの一連の流れを取りまとめるためのプロシージャです。
|
|
40
|
+
|
|
23
41
|
Private Sub GoogleSearch(ByRef cell As Range)
|
|
24
42
|
|
|
25
43
|
Dim query As String
|
|
26
44
|
|
|
45
|
+
'セルに含まれる値を取り出し、文字列型にします。数字や時刻であっても文字列になります。
|
|
46
|
+
|
|
27
47
|
query = CStr(cell.Value2)
|
|
28
48
|
|
|
29
49
|
|
|
30
50
|
|
|
31
51
|
Dim html As String
|
|
32
52
|
|
|
53
|
+
'指定のURLにアクセスして、サーバから返ってくるHTMLをテキストで取得します。
|
|
54
|
+
|
|
33
55
|
html = FetchHtml("https://www.google.co.jp/search?tbm=isch&q=" & query)
|
|
34
56
|
|
|
35
57
|
|
|
36
58
|
|
|
37
59
|
Dim nextUrl As String
|
|
38
60
|
|
|
61
|
+
'HTMLテキストを探索して、最初に見つかる画像URLを取り出します。
|
|
62
|
+
|
|
39
63
|
nextUrl = FindFirstUrlFromGoogleImageSearch(html)
|
|
40
64
|
|
|
41
65
|
|
|
42
66
|
|
|
67
|
+
'上で得た画像URLにアクセスし、ファイルをダウンロードして一時フォルダに保存します。
|
|
68
|
+
|
|
43
69
|
DownloadFileToTempDir nextUrl
|
|
44
70
|
|
|
45
71
|
|
|
46
72
|
|
|
73
|
+
'一時フォルダに保存された画像をシートに貼り付けます。
|
|
74
|
+
|
|
47
75
|
AddPicture cell
|
|
48
76
|
|
|
49
77
|
End Sub
|
|
50
78
|
|
|
51
79
|
|
|
52
80
|
|
|
81
|
+
'変数[url]にアクセスしてHTMLをテキストで返します。
|
|
82
|
+
|
|
53
83
|
Private Function FetchHtml(ByVal url As String) As String
|
|
54
84
|
|
|
85
|
+
'JavaScriptではXMLHttpRequestと呼ばれるオブジェクトです。
|
|
86
|
+
|
|
55
87
|
Dim xhr As Object
|
|
56
88
|
|
|
57
89
|
Set xhr = CreateObject("MSXML2.XMLHTTP")
|
|
58
90
|
|
|
59
91
|
|
|
60
92
|
|
|
93
|
+
'GETリクエストを非同期で要求するよう接続をオープンします。
|
|
94
|
+
|
|
61
95
|
xhr.Open "GET", url, True
|
|
62
96
|
|
|
97
|
+
'要求を送信します。
|
|
98
|
+
|
|
63
99
|
xhr.send
|
|
64
100
|
|
|
65
101
|
|
|
66
102
|
|
|
103
|
+
'Do (While|Until) ~ Loopは与えられた条件が成り立っている間、あるいは成り立つまで繰り返します。
|
|
104
|
+
|
|
67
105
|
Do Until xhr.readyState = 4
|
|
68
106
|
|
|
107
|
+
'DoEventsはウィンドウメッセージを処理させる命令です。
|
|
108
|
+
|
|
109
|
+
'待機中、画面が応答なしになるのを防ぐ、くらいに思っておけばいいでしょう。
|
|
110
|
+
|
|
69
111
|
DoEvents
|
|
70
112
|
|
|
71
113
|
Loop
|
|
72
114
|
|
|
73
115
|
|
|
74
116
|
|
|
117
|
+
'応答結果を返り値に設定します。
|
|
118
|
+
|
|
75
119
|
FetchHtml = xhr.responseText
|
|
76
120
|
|
|
77
121
|
|
|
78
122
|
|
|
123
|
+
'オブジェクト解放
|
|
124
|
+
|
|
79
125
|
Set xhr = Nothing
|
|
80
126
|
|
|
81
127
|
End Function
|
|
@@ -86,6 +132,12 @@
|
|
|
86
132
|
|
|
87
133
|
'ref: http://www.ka-net.org/blog/?p=4855
|
|
88
134
|
|
|
135
|
+
|
|
136
|
+
|
|
137
|
+
'定数宣言です。
|
|
138
|
+
|
|
139
|
+
'定数とは、変数と違って一度定義したら変えられない特殊な変数のようなものです。
|
|
140
|
+
|
|
89
141
|
Const adTypeBinary = 1
|
|
90
142
|
|
|
91
143
|
Const adSaveCreateOverWrite = 2
|
|
@@ -100,6 +152,8 @@
|
|
|
100
152
|
|
|
101
153
|
xhr.Open "GET", url, True
|
|
102
154
|
|
|
155
|
+
'HTTPヘッダを設定します。詳しくはネットワーク系の基礎を勉強してください。
|
|
156
|
+
|
|
103
157
|
xhr.setRequestHeader "Pragma", "no-cache"
|
|
104
158
|
|
|
105
159
|
xhr.setRequestHeader "Cache-Control", "no-cache"
|
|
@@ -118,74 +172,128 @@
|
|
|
118
172
|
|
|
119
173
|
|
|
120
174
|
|
|
175
|
+
'ADODB.Streamはデータストリームを汎用的に扱うためのAPI群を提供します。
|
|
176
|
+
|
|
121
177
|
With CreateObject("ADODB.Stream")
|
|
122
178
|
|
|
179
|
+
'保存するものは画像なので、扱うデータはバイナリであることを設定しています。
|
|
180
|
+
|
|
181
|
+
'ファイルをメモ帳で開いて文字化けしていなかったら「テキスト」、それ以外はすべて「バイナリ」くらいの認識でいいです。
|
|
182
|
+
|
|
123
183
|
.Type = adTypeBinary
|
|
124
184
|
|
|
185
|
+
'ストリームをオープンします。
|
|
186
|
+
|
|
125
187
|
.Open
|
|
126
188
|
|
|
189
|
+
'ストリームにデータを書き込みます。中身はバイナリなので人間には読めません。
|
|
190
|
+
|
|
127
191
|
.Write xhr.responseBody
|
|
128
192
|
|
|
193
|
+
'ストリームの中身をファイルに出力します。
|
|
194
|
+
|
|
129
195
|
.SaveToFile Environ("TEMP") & "\vbatemp", adSaveCreateOverWrite
|
|
130
196
|
|
|
197
|
+
'ストリームを閉じます。
|
|
198
|
+
|
|
131
199
|
.Close
|
|
132
200
|
|
|
133
201
|
End With
|
|
134
202
|
|
|
203
|
+
|
|
204
|
+
|
|
205
|
+
'オブジェクト解放
|
|
206
|
+
|
|
207
|
+
Set xhr = Nothing
|
|
208
|
+
|
|
135
209
|
End Sub
|
|
136
210
|
|
|
137
211
|
|
|
138
212
|
|
|
213
|
+
'HTMLテキストから最初に見つかる画像URLを返します。
|
|
214
|
+
|
|
139
215
|
Private Function FindFirstUrlFromGoogleImageSearch(ByVal html As String) As String
|
|
140
216
|
|
|
141
217
|
Dim partOfHtml As String
|
|
142
218
|
|
|
219
|
+
'Long型は32bit長のビットで表せる整数です。VB.NETでのLong（こちらは64bit）とは別物です。
|
|
220
|
+
|
|
143
221
|
Dim idx As Long
|
|
144
222
|
|
|
145
223
|
|
|
146
224
|
|
|
225
|
+
'HTMLソースの何文字目に "imgurl=" という文字列が含まれるのかを idx に格納します。
|
|
226
|
+
|
|
147
227
|
idx = InStr(html, "imgurl=")
|
|
148
228
|
|
|
229
|
+
'idx + 7 番目から後の文字列を抽出します。
|
|
230
|
+
|
|
149
231
|
partOfHtml = Mid(html, idx + 7)
|
|
150
232
|
|
|
233
|
+
'抽出後の文字列の何番目に "&" という文字列が含まれるのかを idx に格納します。
|
|
234
|
+
|
|
151
235
|
idx = InStr(partOfHtml, "&")
|
|
152
236
|
|
|
153
237
|
|
|
154
238
|
|
|
239
|
+
'最初から idx - 1 番目までを抽出して、返り値に設定します。
|
|
240
|
+
|
|
155
241
|
FindFirstUrlFromGoogleImageSearch = Left(partOfHtml, idx - 1)
|
|
156
242
|
|
|
157
243
|
End Function
|
|
158
244
|
|
|
159
245
|
|
|
160
246
|
|
|
247
|
+
'与えられたRange型（セル）の右隣に、あらかじめ保存された画像を貼り付けます。
|
|
248
|
+
|
|
161
249
|
Private Sub AddPicture(ByRef cell As Range)
|
|
162
250
|
|
|
163
251
|
Dim shape As shape
|
|
164
252
|
|
|
253
|
+
'ここの詳しいパラメータの機能は私もよくは知りません。
|
|
254
|
+
|
|
165
255
|
Set shape = ActiveSheet.Shapes.AddPicture( _
|
|
166
256
|
|
|
167
257
|
Filename:=Environ("TEMP") & "\vbatemp", _
|
|
168
258
|
|
|
259
|
+
'Excelでの画像貼り付けには複数の方法があり、
|
|
260
|
+
|
|
261
|
+
'ファイルへのリンクとするのかExcelファイル自体に画像を含ませるのかを選択できます。
|
|
262
|
+
|
|
263
|
+
'ここではExcelファイルに埋め込んでいます。
|
|
264
|
+
|
|
169
265
|
LinkToFile:=False, _
|
|
170
266
|
|
|
171
267
|
SaveWithDocument:=True, _
|
|
172
268
|
|
|
269
|
+
'シートのA1の左上隅を頂点として、右にどのくらいずらすのかを指定します。
|
|
270
|
+
|
|
173
271
|
Left:=cell.Left + cell.width, _
|
|
174
272
|
|
|
273
|
+
'シートのA1の左上隅を頂点として、下にどのくらいずらすのかを指定します。
|
|
274
|
+
|
|
175
275
|
Top:=cell.Top, _
|
|
176
276
|
|
|
277
|
+
'貼り付ける画像の縦幅、横幅を指定します。
|
|
278
|
+
|
|
279
|
+
'ここでは両方とも 0 に指定していますが、下でさらに別の設定をしています。
|
|
280
|
+
|
|
177
281
|
width:=0, _
|
|
178
282
|
|
|
179
283
|
height:=0)
|
|
180
284
|
|
|
181
285
|
|
|
182
286
|
|
|
287
|
+
'貼り付けられた画像の縦幅横幅を、画像そのものの大きさに一致するようにします。
|
|
288
|
+
|
|
183
289
|
shape.ScaleHeight 1, msoTrue
|
|
184
290
|
|
|
185
291
|
shape.ScaleWidth 1, msoTrue
|
|
186
292
|
|
|
187
293
|
|
|
188
294
|
|
|
295
|
+
'オブジェクト解放
|
|
296
|
+
|
|
189
297
|
Set shape = Nothing
|
|
190
298
|
|
|
191
299
|
End Sub
|