質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.63%

ExcelVBAにて画像URLから画像を取得し、指定のセルに挿入する方法

解決済

回答 1

投稿

  • 評価
  • クリップ 1
  • VIEW 15K+

kaito2280

score 7

前提・実現したいこと

ExcelVBAにて、画像URL(〜〜.jpg)が挿入されている列があり、その列のURLから画像を取得したものを、指定の列に画像として表示させる操作を自動化したいと思っています。
このソースでは”G列”にある画像URLを”A列”に表示させようとしています。
このソースはYahoo!知恵袋より収得しました。

発生している問題・エラーメッセージ

エラー"1004"
アプリケーション定義または、オブジェクト定義のエラーです。

該当のソースコード

Sub Macro()
Dim i As Long, imax As Long
Dim sp As Shape
imax = Cells(Rows.Count, 7).End(xlUp).Row
For i = 2 To imax
Cells(i, 1).Select
p = "" & Cells(i, 7).Value & ""
ActiveSheet.Pictures.Insert(p).Select
Next
For Each sp In ActiveSheet.Shapes
sp.Width = 50 '[幅を指定する]
sp.Height = 30 '[高さを指定する]
Next
End Sub

試したこと

GoogleやYahoo!知恵袋での検索。
ブレークポイント挿入によるエラー検証。
(ActiveSheet.Pictures.Insert(p).Selectの部分でエラーが発生している模様)

補足情報(言語/FW/ツール等のバージョンなど)

当方、HTML/CSS、簡単なRuby、Delphiしか触ったことがありません。
ExcelVBAの知識はほとんどありません。
現状はMac版で最新のExcelを使用しています。
VBEを開き、この操作を行いたいシートのVBEに上記のソースを入力しているだけの状態になっています。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

+1

こちらの質問が参考になるかも。
https://teratail.com/questions/40321


上記質問に書いた自分のコードの修正版です。
お試しください。
但し、Macでは未検証です。

Sub Macro()
    Dim r As Long
    r = 2
    While Cells(r, 7) <> ""
        Set Picture = ActiveSheet.Shapes.AddPicture( _
            Filename:=Cells(r, 7), _
            LinkToFile:=False, SaveWithDocument:=True, _
            Left:=Cells(r, 1).Left, Top:=Cells(r, 1).Top, _
            Width:=50, Height:=50)
        r = r + 1
    Wend
End Sub

エラー処理追加1(エラーを無視する)

Sub Macro()
    On Error Resume Next           ' <===これを追加
    Dim r As Long
    r = 2
    While Cells(r, 7) <> ""
        Set Picture = ActiveSheet.Shapes.AddPicture( _
            Filename:=Cells(r, 7), _
            LinkToFile:=False, SaveWithDocument:=True, _
            Left:=Cells(r, 1).Left, Top:=Cells(r, 1).Top, _
            Width:=50, Height:=50)
        r = r + 1
    Wend
End Sub


エラー処理追加2(エラー情報を取得する)

Sub Macro()
    On Error Goto ErrHandle           ' <===これを追加
    Dim r As Long
    r = 2
    While Cells(r, 7) <> ""
        Set Picture = ActiveSheet.Shapes.AddPicture( _
            Filename:=Cells(r, 7), _
            LinkToFile:=False, SaveWithDocument:=True, _
            Left:=Cells(r, 1).Left, Top:=Cells(r, 1).Top, _
            Width:=50, Height:=50)
        r = r + 1
    Wend
    Exit Sub                     ' <==== ここから先を追加
ErrHandle:
    MsgBox Err.Description
'    Resume Next                 ' 処理を継続する場合はこの行を有効化
End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/09/08 13:27

    ttyp03さん
    ありがとうございます!!
    動作しました!
    何から何までありがとうございました。
    もっと勉強いたします。。

    キャンセル

  • 2016/09/08 13:29

    Macで動かなかったのが気がかりですが、とりあえずできて良かったです。

    キャンセル

  • 2016/09/08 15:09

    Macで試すとエラーコードも出ず、プログラム自体が実行されませんでした。
    WindowsとMacでなぜExcelの作りが違うのかは疑問ですが、、、

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.63%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る