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

回答編集履歴

2

コード修正

2019/03/28 00:00

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -19,13 +19,12 @@
19
19
  Cells(i, 3).Select
20
20
  p = Cells(i, 28).Value
21
21
 
22
- On Error GoTo ErrLabel
22
+ On Error Resume Next
23
23
  With ActiveSheet.Pictures.Insert(p)
24
24
  .Width = 90 '[幅を指定する]
25
25
  .Height = 90 '[高さを指定する]
26
26
  End With
27
- ErrLabel:
27
+ On Error Goto 0
28
- Resume Next
29
28
  Next
30
29
 
31
30
  End Sub

1

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

2019/03/28 00:00

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -2,6 +2,31 @@
2
2
  `Dim sp As Picture` に修正。
3
3
 
4
4
  `For Each sp In ActiveSheet.Shapes` を、
5
- 'For Each sp In ActiveSheet.Pictures' に修正。
5
+ `For Each sp In ActiveSheet.Pictures` に修正。
6
6
 
7
- `Shapes` `Pictures` の意味を調べしましょう。
7
+ `Shapes` `Pictures` の意味を調べしましょう。
8
+
9
+ 追記
10
+ ---
11
+ ループを追加とサイズ変更の2つに分けずに、追加したらすぐサイズ変更する方がシンプルになりますね。
12
+ ```vba
13
+ Sub ImageCapture()
14
+ Dim i As Long, imax As Long
15
+ Dim p As String
16
+
17
+ imax = Cells(Rows.Count, 28).End(xlUp).Row
18
+ For i = 3 To imax
19
+ Cells(i, 3).Select
20
+ p = Cells(i, 28).Value
21
+
22
+ On Error GoTo ErrLabel
23
+ With ActiveSheet.Pictures.Insert(p)
24
+ .Width = 90 '[幅を指定する]
25
+ .Height = 90 '[高さを指定する]
26
+ End With
27
+ ErrLabel:
28
+ Resume Next
29
+ Next
30
+
31
+ End Sub
32
+ ```