質問編集履歴
2
改善したコードを書き足しました。
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
改善したコードを書き足しました。
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
|
+
ということに気づきましたので、もういっかい考えます。
|