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

質問編集履歴

2

改善したコードを書き足しました。

2018/03/28 08:14

投稿

sumire_cl
sumire_cl

スコア228

title CHANGED
File without changes
body CHANGED
@@ -176,4 +176,88 @@
176
176
  ```
177
177
  ここまで書いてから、h.horikoshiさんの回答を見て
178
178
  「目的のページ1枚だけを戻すほうがいいっぽい…」
179
- ということに気づきましたので、もういっかい考えます。
179
+ ということに気づきましたので、もういっかい考えます。
180
+
181
+ ###追加2(できた!)
182
+ ```VBA
183
+ Sub entryDenpyo()
184
+
185
+ Dim sh As Object '起動中のShellWindow一式を格納する
186
+ Dim ie As InternetExplorer 'FindPages関数で見つけたIEを格納する
187
+ Dim inputbutton As HTMLAnchorElement 'ボタンとかを探すときに要素を格納する
188
+ Dim i As Long 'イテレータ
189
+ Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行
190
+
191
+
192
+ '*-- 起動中のShellWindow一式を変数shに格納 --*
193
+ Set sh = CreateObject("Shell.Application")
194
+
195
+ '*-- IEで開かれている[伝票番号入力]ページを探す、1個だけ開かれてるんじゃなかったら処理はしない。 --*
196
+ Set ie = FindPages(sh,"伝票番号入力")
197
+
198
+ If (Not (ie Is Nothing)) Then
199
+ '*-- シートの伝票番号の数だけ繰り返す --*
200
+ For i = 1 To endRow Step 1
201
+ '*-- 伝票番号を入れて登録ボタンを押す --*
202
+ ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value
203
+ For Each inputbutton In ie.document.getElementsByTagName("input")
204
+ If inputbutton.Value = "登録" Then
205
+ inputbutton.Click
206
+ Exit For
207
+ End If
208
+ Next
209
+ Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
210
+ DoEvents
211
+ Loop
212
+ Next i
213
+ else
214
+ MsgBox "登録画面がみつかりません!"
215
+ End If
216
+
217
+ '*-- いろいろ解放 --*
218
+ Set sh = Nothing
219
+ Set ie = Nothing
220
+ MsgBox "おわりました"
221
+
222
+ End Sub
223
+
224
+ '*-- 開いているIEのページを目的の1個だけ戻す。ページがなかったり複数だったりしたらNothingを戻す。 --*
225
+ Function FindPages(ByVal shs As Object, ByVal pagetitle As String) As InternetExplorer
226
+
227
+ Dim win As Object '各ShellWindowを格納する
228
+ Dim document_title As String 'IEのドキュメントタイトルを格納する
229
+ Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する
230
+
231
+ Set FindPages = Nothing
232
+ For Each win In shs.Windows
233
+ 'ドキュメントタイトル取得失敗を無視(処理継続)--*
234
+ On Error Resume Next
235
+
236
+ If TypeName(win.document) = "HTMLDocument" Then
237
+ document_title = ""
238
+ document_title = win.document.Title
239
+ On Error GoTo 0
240
+
241
+ '*-- IEだったらタイトルで探す --*
242
+ Set ie = win
243
+ If InStr(document_title, pagetitle) > 0 Then
244
+ If FindPages Is Nothing Then
245
+ Set FindPages = ie
246
+ Else
247
+ MsgBox pagetitle & ("画面を1個だけ開いて、あとは閉じてください。")
248
+ Set FindPages = Nothing
249
+ Exit Function
250
+ End If
251
+ End If
252
+ End If
253
+ Next
254
+
255
+ End Function
256
+ ```
257
+ 皆様のご指導のもとに、とても改善して書けました!
258
+ 「開いているIEのページを目的の1個だけ戻す」というのは
259
+ 他にも1件ずつエントリするような作業がいろいろありますので(社内システムがイケてないので……)
260
+ この部分を関数にできたので、使いまわせそうな気がします。
261
+
262
+ ベストアンサーっていっぱいつけられないのですね……
263
+ teratailは先生がいっぱいいるので嬉しいです!ありがとうございます。

1

改善したコードを書き足しました。

2018/03/28 08:14

投稿

sumire_cl
sumire_cl

スコア228

title CHANGED
File without changes
body CHANGED
@@ -96,4 +96,84 @@
96
96
 
97
97
  ### 補足情報(FW/ツールのバージョンなど)
98
98
 
99
- Win10、Excel2016、IE11です。
99
+ Win10、Excel2016、IE11です。
100
+
101
+ ###追加1
102
+ 皆様ありがとうございます!
103
+ 教えていただいた内容を踏まえて、関数にしてみました。
104
+ ```VBA
105
+ Sub entryDenpyo()
106
+
107
+ Dim sh As Object '起動中のShellWindow一式を格納する
108
+ Dim win As New Collection '各ShellWindowを格納する
109
+ Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する
110
+ Dim document_title As String 'IEのドキュメントタイトルを格納する
111
+ Dim inputbutton As HTMLAnchorElement 'ボタンとかを探すときに要素を格納する
112
+ Dim i As Long 'イテレータ
113
+ Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行
114
+
115
+
116
+ '*-- 起動中のShellWindow一式を変数shに格納 --*
117
+ Set sh = CreateObject("Shell.Application")
118
+
119
+ '*-- IEで開かれている[伝票番号入力]ページを探す、1個だけ開かれてるんじゃなかったら処理はしない。 --*
120
+ Set win = FindPages(sh,"伝票番号入力")
121
+ If win.Count = 1 Then
122
+ Set ie = win(1)
123
+ Else
124
+ MsgBox ("伝票番号入力画面を1個だけ開いて、あとは閉じてください。")
125
+ Exit Sub
126
+ End If
127
+
128
+ '*-- シートの伝票番号の数だけ繰り返す --*
129
+ For i = 1 To endRow Step 1
130
+ '*-- 伝票番号を入れて登録ボタンを押す --*
131
+ ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value
132
+ For Each inputbutton In ie.document.getElementsByTagName("input")
133
+ If inputbutton.Value = "登録" Then
134
+ inputbutton.Click
135
+ Exit For
136
+ End If
137
+ Next
138
+ Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
139
+ DoEvents
140
+ Loop
141
+ Next i
142
+
143
+ '*-- いろいろ解放 --*
144
+ Set sh = Nothing
145
+ Set ie = Nothing
146
+
147
+ End Sub
148
+
149
+ '*-- 開いているIEのページをcollectionに入れて戻す --*
150
+ Function FindPages(ByVal shs As Object,ByVal pagetitle as string) As Collection
151
+
152
+ Dim win As Object '各ShellWindowを格納する
153
+ Dim document_title As String 'IEのドキュメントタイトルを格納する
154
+ Dim ie As InternetExplorer 'ShellWindowから見つけたIEを格納する
155
+ Dim clIE As New Collection 'コレクション格納用
156
+
157
+ For Each win In shs.Windows
158
+ 'ドキュメントタイトル取得失敗を無視(処理継続)--*
159
+ On Error Resume Next
160
+
161
+ If TypeName(win.document) = "HTMLDocument" Then
162
+ document_title = ""
163
+ document_title = win.document.Title
164
+ On Error GoTo 0
165
+
166
+ '*-- タイトルで探す --*
167
+ Set ie = win
168
+ If InStr(document_title, pagetitle) > 0 Then
169
+ clIE.Add ie '合致したページをコレクションに格納
170
+ Set FindPages = clIE
171
+ End If
172
+ End If
173
+ Next
174
+
175
+ End Function
176
+ ```
177
+ ここまで書いてから、h.horikoshiさんの回答を見て
178
+ 「目的のページ1枚だけを戻すほうがいいっぽい…」
179
+ ということに気づきましたので、もういっかい考えます。