teratail header banner
teratail header banner
質問するログイン新規登録

質問編集履歴

1

追記

2016/07/07 00:29

投稿

future
future

スコア62

title CHANGED
File without changes
body CHANGED
@@ -5,7 +5,9 @@
5
5
  Excel上に画像URLが縦に並んでいるとします。(http://〜)
6
6
  その横にURLにアクセスすると表示される画像を貼り付ける事は可能でしょうか?
7
7
 
8
+ ```lang-VBA
8
9
  ActiveSheet.Pictures.Insert("{画像URL}").Select
10
+ ```
9
11
 
10
12
  を使用してみたのですが、
11
13
 
@@ -14,4 +16,40 @@
14
16
 
15
17
  と表示されました。
16
18
 
17
- 現状この方法では貼り付ける事は出来ないのでしょうか?
19
+ 現状この方法では貼り付ける事は出来ないのでしょうか?
20
+
21
+
22
+ ※追記
23
+ 以下の方法で画像の貼り付けは出来たのですが、
24
+ 画像のサイズがセルのサイズとなってしまい、縦横比率がおかしくなってしまいます。
25
+ 縦横比率を保つようにする事は可能なのでしょうか?
26
+
27
+ ```lang-VBA
28
+ Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
29
+ "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
30
+ szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
31
+
32
+ Sub PicDownLoad()
33
+ Dim strFname As String, strUrl As String
34
+ Dim retValue As Long, i As Long
35
+ Dim endRow As Long
36
+ endRow = Cells(Rows.Count, 1).End(xlUp).Row
37
+ For i = 1 To endRow
38
+ strUrl = Cells(i, 1).Text
39
+ If strUrl <> "" Then
40
+ strFname = "D:\rinji\" & Mid(strUrl, InStrRev(strUrl, "/") + 1)
41
+ retValue = URLDownloadToFile(0, strUrl, strFname, 0, 0)
42
+ If retValu = 0 Then
43
+ With Cells(i, 2)
44
+ Set objShape = ActiveSheet.Shapes.AddPicture( _
45
+ Filename:=strFname, LinkToFile:=False, _
46
+ SaveWithDocument:=True, Left:=.Left, _
47
+ Top:=.Top, Width:=.Width, Height:=.Height)
48
+ End With
49
+ Else
50
+ MsgBox "DownLoad Fail " & Chr(10) & strUrl
51
+ End If
52
+ End If
53
+ Next i
54
+ End Sub
55
+ ```