VBAプログラム開発、スクレイピング【5】複数の画像データを取得し、Excelで表示する

Webページ上の一覧表示にある画像データをスクレイピングしてExcelワークシートに表示させることを前回実施しました。

しかし、まだ1件のデータが扱えるようになった状態ですので、Web一覧表示全件に対応させていきます。

今回の目的

Web一覧表示画像データをすべて取得しExcel上の対象レコードとして表示させる

なぜやるか

Web一覧表示の全データ取得VBAを完成させる為

やりたいこと

• スクレイピングによって全画像データURLを取得する
• 取得したURLを利用しExcel上に全画像を表示させる
• レコード単位の表示となるように画像位置を調整する

やったこと 

• 残工程の手順を検討する
• 画像URLを複数取得してURLテキストをExcel上に表示させる
• 画像URLを使用してExcel上に画像を表示させる
• Excel上で画像を並べて表示させる
• Excelの指定位置に画像を表示させる

実施内容

残りの工程を考える

単体で画像を扱うことが可能となりました。

残っている作業として考えられるのは…。

• 複数のデータを取得して、全て表示させる
• 表示位置を調整する

まず全件のデータを取得します。これは今までのスクレイピングの方法を利用すればすぐ出来そうです。

データが取得できれば、次に出力します。今回は画像を出力するのでAddPictureを利用します。こちらは、画像の位置をピクセルで指定するので、セル位置はつかえません。

これをどう扱うかを検討する必要があります。

画像を全て出力できるようになれば、後は画像は5行目に表示位置を準備しているので、対象の位置に表示させてやれば完了となりそうです。しかし、同じくセル位置指定が使えない為、こちらも併せて検討が必要です。

画像出力の位置指定がポイントとなりそうです。

複数データに対応させる

画像URLを取得する

まずは、全画像のURLを取得し、Excel上に表示させてみます。

# スクレイピング

Dim imgURL As String

Dim Img As Object
i = 1
For Each Img In htmlDoc.images 'イメージ取得
　imgURL = Img.src '変数格納
　Worksheets("スクレイピング").Cells(i + 1, 5).Value = imgURL '取得URL反映

　i = i + 1

Next Img

htmlDoc.imagesで取得したイメージデータをFor Eachで順番に処理できるようにし、そこからsrcに記述しているURLを取得してExcelへ出力する形式としました。

複数画像URL取得

画像として指定しているURLを取得してExcelに表示させることができました。後は、このURLをAddPictureで指定してやれば、画像が表示出来そうです。

画像を一覧表示する 

先程画像URLを取得したコードの続きにAddPictureを利用して画像を表示する処理を追記します。

# スクレイピング

Dim imgURL As String

Dim Img As Object
i = 1
For Each Img In htmlDoc.images 'イメージ取得
　imgURL = Img.src '変数格納
　Worksheets("スクレイピング").Cells(i + 1, 5).Value = imgURL '取得URL反映

　i = i + 1

　Worksheets("スクレイピング").Shapes.AddPicture _
　　fileName:=imgURL, _
　　　LinkToFile:=True, _
　　　SaveWithDocument:=True, _
　　　Left:=0, _
　　　Top:=0, _
　　　Width:=100, _
　　　Height:=100

Next Img

imgURLに画像URLが格納されているので、fileNameで変数を指定することで対象の画像が参照され、画像がExcelに表示されるという流れです。

この状態で動作を確認します。

複数画像スクレイピング

画像は表示できましたが、ひとつしか表示されていません。

コードを再確認してみました。

Dim imgURL As String

Dim Img As Object
i = 1
For Each Img In htmlDoc.images 'イメージ取得
　imgURL = Img.src '変数格納
　Worksheets("スクレイピング").Cells(i + 1, 5).Value = imgURL '取得URL反映

　i = i + 1

　Worksheets("スクレイピング").Shapes.AddPicture _
　　fileName:=imgURL, _
　　　LinkToFile:=True, _
　　　SaveWithDocument:=True, _
　　　Left:=0, _
　　　Top:=0, _
　　　Width:=100, _
　　　Height:=100

Next Img

表示位置がLeft:=0,Top:=0です。

つまり、何度繰り返しても同じ位置に画像を表示する状態になっていました…。

上にある画像をドラッグ

Excelに表示されている画像をドラッグすると下の画像が見えるようになっていました。

画像を順番に表示する

画像の表示位置はAddPicture内のLeft,Topによる指定でした。

ForEach内でこの値を変化させて画像を重ねることなく順番に表示できるように修正します。

Dim imgURL As String

Dim Img As Object

Dim toppix As Long
i = 1
For Each Img In htmlDoc.images 'イメージ取得
　imgURL = Img.src '変数格納
　Worksheets("スクレイピング").Cells(i + 1, 5).Value = imgURL '取得URL反映

　i = i + 1

　Worksheets("スクレイピング").Shapes.AddPicture _
　　fileName:=imgURL, _
　　　LinkToFile:=True, _
　　　SaveWithDocument:=True, _
　　　Left:=0, _
　　　Top:=0 + toppix, _
　　　Width:=100, _
　　　Height:=100

　toppix = toppix + 100

Next Img

画像サイズを100と指定しているので、1つめは0ピクセルを指定しておき、以降は+100ピクセルを加算することで、位置を変更させてみました。

画像を順番に表示

こうすることで、計算結果を利用して、画像が順番に縦にならんでくれました。

しかし、見ての通りこれではまだ不十分です。

画像データを取得して順番に表示する所まではできましたが、画像表示位置は5列目に作成しています。

5列目にはURLのテキストを表示していましたが、本来はここに画像を表示させ、レコード単位でWebのデータをExcelにまとめるのが目的です。

Excel表のスタイルを調整する

画像の表示位置を修正すれば完成するところまで実施できているので、ここで見栄えを整えることにしました。

スタイル修正後

表の幅を調整しました。

調整後テキスト表示

スクレイピングによってテキストのみを反映させてみました。

画像欄にURLではなく、画像がきっちり表示できればWeb上の一覧表示データが全て表示できる状態まできました。

 

画像の表示位置を調整する

値の設定方法を確認する

画像の表示は5列目の画像欄に表示させることができれば完了です。 

Worksheets("スクレイピング").Shapes.AddPicture _
　fileName:=imgURL, _
　　LinkToFile:=True, _
　　SaveWithDocument:=True, _
　　Left:=0, _
　　Top:=0 + toppix, _
　　Width:=100, _
　　Height:=100

表示位置はLeft,Topにピクセル指定で記載していました。

先程縦方向に一覧表示するにあたっては、定数を加算していました。

しかし、高さが変更になると、修正が必要です。できれば、画像表示セルに出力できるような表現にしたいところです。

一方でテキストで出力したURLはセル位置で指定しています。

Worksheets("スクレイピング").Cells(i + 1, 5).Value = imgURL

画像表示位置イメージ

cells()指定で場所を指定することで、URLが表示されています。この位置情報をピクセルで取得さえできれば、AddPictureの値として指定できそうです。

セルの位置をピクセルで取得する

セルに対してピクセルで情報が取得できるようなので、まずこれを確認します。

ピクセル値を取得したい

黄色のセル(E2)にアクティブセルがある状態です。

この位置のピクセル情報を取得します。

# ピクセル取得

Sub pixel()
　Dim test As Variant
　MsgBox ActiveCell.Left
End Sub

テスト用のVBAコードで、アクティブセルに対してのLeftの値をメッセージボックスで出力します。

.Left値出力

値が取得できました。左端から611.25の位置ということが分かりました。

次は上からの位置を取得します。セル指定もアクティブセルではなく、位置を指定します。

# ピクセル取得

Sub pixel()
　Dim test As Variant
　MsgBox Worksheets("スクレイピング").Cells(2, 5).Top
End Sub

cells(2,5)としてE2セルを指定し、Topオプションで上からの位置を指定しました。

.Top値出力

11.25が表示されました。

セル位置指定＋Left,Top指定を利用すればセルの位置をピクセルで取得できそうです。

セル番地・ピクセル情報を利用する

セル番地とLeft or Topを組み合わせればピクセル値が取得できましたので、この記法を用いてコードを修正してみました。

# スクレイピング（画像処理部のみ）

'画像用変数
Dim imgURL As String '画像URL
Dim Img As Object '画像オブジェクト
Dim ActCell As Object '画像出力セル

i = 1

For Each Img In htmlDoc.images '画像要素取得
　imgURL = Img.src '画像URL取得
　Set ActCell = Worksheets("スクレイピング").Cells(i + 1, 5)

　'画像出力セルのピクセルを指定して表示
　Worksheets("スクレイピング").Shapes.AddPicture _
　　fileName:=imgURL, _
　　　LinkToFile:=True, _
　　　SaveWithDocument:=True, _
　　　Left:=ActCell.Left, _
　　　Top:=ActCell.Top, _
　　　Width:=100, _
　　　Height:=100

　i = i + 1
Next Img

worksheets().cells()と何度も記述していたので、Setを使用しActCell変数に格納することで、残りの記述を簡単にしました。

画像表示をする5列目は画像URLテキストを表示させていました。

しかし、テキスト自体は出力する必要はないので、テキスト表示をしていたコードは削除しました。

セルの位置さえ取得できれば、AddPictureでピクセルを設定してやれば画像を意図したところに表示できます。

これでVBAを動作させて、表示を確認します。

セル位置＋ピクセル指定で画像取得

指定したセルの位置で表示することができました。

セル番地指定なので、行の高さを編集しても、対応可能となりました。

以上で画像出力の処理は完了です。

これでindex画面に出力される一覧情報をスクレイピングによってExcelに取得することが可能になりました。

次回はさらにこの機能を拡張させていきたいと考えていますので、そちらを実施していきます。