回答編集履歴

2

コード修正

2019/03/28 00:00

投稿

hatena19
hatena19

スコア33755

test CHANGED
@@ -40,7 +40,7 @@
40
40
 
41
41
 
42
42
 
43
- On Error GoTo ErrLabel
43
+ On Error Resume Next
44
44
 
45
45
  With ActiveSheet.Pictures.Insert(p)
46
46
 
@@ -50,9 +50,7 @@
50
50
 
51
51
  End With
52
52
 
53
- ErrLabel:
53
+ On Error Goto 0
54
-
55
- Resume Next
56
54
 
57
55
  Next
58
56
 

1

書式の改善、コードの追記

2019/03/28 00:00

投稿

hatena19
hatena19

スコア33755

test CHANGED
@@ -6,8 +6,58 @@
6
6
 
7
7
  `For Each sp In ActiveSheet.Shapes` を、
8
8
 
9
- 'For Each sp In ActiveSheet.Pictures' に修正。
9
+ `For Each sp In ActiveSheet.Pictures` に修正。
10
10
 
11
11
 
12
12
 
13
13
  `Shapes` `Pictures` の意味を調べしましょう。
14
+
15
+
16
+
17
+ 追記
18
+
19
+ ---
20
+
21
+ ループを追加とサイズ変更の2つに分けずに、追加したらすぐサイズ変更する方がシンプルになりますね。
22
+
23
+ ```vba
24
+
25
+ Sub ImageCapture()
26
+
27
+ Dim i As Long, imax As Long
28
+
29
+ Dim p As String
30
+
31
+
32
+
33
+ imax = Cells(Rows.Count, 28).End(xlUp).Row
34
+
35
+ For i = 3 To imax
36
+
37
+ Cells(i, 3).Select
38
+
39
+ p = Cells(i, 28).Value
40
+
41
+
42
+
43
+ On Error GoTo ErrLabel
44
+
45
+ With ActiveSheet.Pictures.Insert(p)
46
+
47
+ .Width = 90 '[幅を指定する]
48
+
49
+ .Height = 90 '[高さを指定する]
50
+
51
+ End With
52
+
53
+ ErrLabel:
54
+
55
+ Resume Next
56
+
57
+ Next
58
+
59
+
60
+
61
+ End Sub
62
+
63
+ ```