teratail
回答率
85.48%
質問するログイン新規登録
トップに関する質問VBAで画像を指定場所に張り付けたいです。

編集履歴

質問編集履歴

1

所定のコード入力に変更しました

2020/07/14 07:40

投稿

tanetanetane
tanetanetane

スコア6

test CHANGED
File without changes
test CHANGED
@@ -1,3 +1,9 @@
1
+ 失礼しました。
2
+
3
+ 再投稿です。
4
+
5
+
6
+
1
7
  VBAで画像を指定場所に張り付けたいです。
2
8
 
3
9
  VBA超初心者です。
@@ -32,166 +38,76 @@
32
38
 
33
39
 
34
40
 
35
- Sub 画像貼り付け()
41
+ ```VBA
36
42
 
37
-
43
+ Sub 画像貼り付け()
38
44
 
39
45
 
40
46
 
41
47
  Dim lngTop As Long
42
48
 
43
- Dim objFile As Object
49
+ Dim objFile As Object
44
50
 
45
- Dim objFldr As FileSystemObject
51
+ Dim objFldr As FileSystemObject
46
52
 
47
- Dim TheShape As Shape
53
+ Dim TheShape As Shape
48
54
 
49
- Dim i As Integer
55
+ Dim i As Integer
50
56
 
51
57
 
52
58
 
53
- Set objFldr = CreateObject("Scripting.FileSystemObject")
59
+ Set objFldr = CreateObject("Scripting.FileSystemObject")
54
60
 
55
-
56
61
 
57
- lngTop = 47.5
58
62
 
59
-
63
+ lngTop = 47.5
64
+
65
+
60
66
 
61
67
  i = 0
62
68
 
63
- For Each objFile In objFldr.GetFolder(ThisWorkbook.Path & "\picture").Files
69
+ For Each objFile In objFldr.GetFolder(ThisWorkbook.Path & "\picture").Files
64
-
65
-
66
-
67
- ActiveSheet.shapes.AddPicture _
68
-
69
- Filename:=objFile, _
70
-
71
- LinkToFile:=False, _
72
-
73
- SaveWithDocument:=True, _
74
-
75
- Left:=11, _
76
-
77
- Top:=lngTop, _
78
-
79
- Width:=252.834, _
80
-
81
- Height:=188.5
82
-
83
-
84
-
85
- i = i + 1
86
70
 
87
71
 
88
72
 
89
-
73
+ ActiveSheet.shapes.AddPicture _
90
74
 
91
- If i Mod 4 = 0 Then
75
+ Filename:=objFile, _
92
76
 
93
-
77
+ LinkToFile:=False, _
94
78
 
95
- lngTop = lngTop + 188.5 + 80
79
+ SaveWithDocument:=True, _
96
80
 
97
-
81
+ Left:=11, _
98
82
 
99
- Else
83
+ Top:=lngTop, _
100
84
 
101
- lngTop = lngTop + 188.5 + 16.05
85
+ Width:=252.834, _
102
86
 
103
- End If
104
-
105
- Next
106
-
107
-
108
-
109
-
110
-
111
-
112
-
113
- 画像を張り付ける位置を指定したいです
87
+ Height:=188.5
114
88
 
115
89
 
116
90
 
117
- Sub 画像貼り付け()
91
+ i = i + 1
118
92
 
119
93
 
120
94
 
121
- Dim lngTop As Long
122
-
123
- Dim objFile As Object
124
-
125
- Dim objFldr As FileSystemObject
126
-
127
- Dim TheShape As Shape
128
-
129
- Dim i As Integer
95
+ If i Mod 4 = 0 Then
130
96
 
131
97
 
132
98
 
99
+ lngTop = lngTop + 188.5 + 80
133
100
 
134
101
 
135
102
 
103
+ Else
104
+
105
+ lngTop = lngTop + 188.5 + 16.05
106
+
107
+ End If
108
+
109
+ Next
136
110
 
137
111
 
138
112
 
139
-
140
-
141
- '設置状況
142
-
143
-
144
-
145
- Set objFldr = CreateObject("Scripting.FileSystemObject")
146
-
147
-
148
-
149
- lngTop = 47.5
150
-
151
-
152
-
153
- i = 0
154
-
155
- For Each objFile In objFldr.GetFolder(ThisWorkbook.Path & "\picture").Files
156
-
157
-
158
-
159
- ActiveSheet.shapes.AddPicture _
160
-
161
- Filename:=objFile, _
162
-
163
- LinkToFile:=False, _
164
-
165
- SaveWithDocument:=True, _
166
-
167
- Left:=11, _
168
-
169
- Top:=lngTop, _
170
-
171
- Width:=252.834, _
172
-
173
- Height:=188.5
174
-
175
-
176
-
177
- i = i + 1
178
-
179
-
180
-
181
-
182
-
183
- If i Mod 4 = 0 Then
184
-
185
-
186
-
187
- lngTop = lngTop + 188.5 + 80
188
-
189
-
190
-
191
- Else
113
+ ```
192
-
193
- lngTop = lngTop + 188.5 + 16.05
194
-
195
- End If
196
-
197
- Next