excel VBAでIEを操作して、必要箇所に入力後実行ボタンをクリックすると新しいタブで表示された画面をすべてコピーしたいのですが、新しいタブの操作方法が分かりません。分かる方宜しくお願い致します。
Dim objIE As InternetExplorer
Set objIE = New InternetExplorerMedium
objIE.Visible = true
objIE.Navigate “アドレス”
‘IEに入力
Call IEButtonClick(objIE,”実行ボタン”)
End sub
Win10のOffice365のExcelを使用しています。
GetOpenFilenameで選択した複数のExcelファイルのファイル名＋印刷ページ数を
マクロを実行したファイルに出力するというマクロを作成しました。
マクロを実行する度に既存データがあれば追加されていくようにしたいのですが、上手くいきません。
それどころか、実行時も複数ファイル選択したにも関わらず、
１ファイルのデータしか出力されない状態です。
実行後のイメージは添付ファイルの通りです。
（A1、A2はデフォルトで入力しています。）
勉強を始めたばかりなので改善点もあれば、教えて頂きたいです。
よろしくお願い致します。
=================================================
Option Explicit
Sub pagecount()
Dim Page As Long, cnt As Long, xlcnt As Long
Dim fs As Variant, path As Variant
Dim Fname As String
Dim i As Integer
Dim wb1 As Workbook, wb2 As Workbook
Dim sh As Worksheet
With CreateObject("WScript.Shell")
.CurrentDirectory = ThisWorkbook.path
End With
fs = Application.GetOpenFilename(filefilter:="Microsoft Excelブック,*.xls*", MultiSelect:=True)
If IsArray(fs) Then
For Each path In fs
Set wb1 = Workbooks.Open(path, , True)
Set wb2 = ThisWorkbook
Do Until (Fname = "")
Page = 0
For Each sh In wb1.Worksheets
Page = Page + sh.PageSetup.Pages.Count
Next sh
xlcnt = Cells(Rows.Count, 1).Row
cnt = Cells(xlcnt, 1).End(xlUp).Row
If wb2.ActiveSheet.Cells(cnt, 1).Value <> "" Then
wb2.ActiveSheet.Cells(cnt, 1).Value = Fname
wb2.ActiveSheet.Cells(cnt, 1).Offset(0, 1) = Page
wb1.Close savechanges:=False
Fname = Dir()
cnt = cnt + 1
End If
Loop
Next path
End If
End Sub
Win10のOffice365のExcelを使用しています。
GetOpenFilenameで選択した複数のExcelファイルのファイル名＋印刷ページ数を
マクロを実行したファイルに出力するというマクロを作成しました。
マクロを実行する度に既存データがあれば追加されていくようにしたいのですが、上手くいきません。
それどころか、実行時も複数ファイル選択したにも関わらず、
１ファイルのデータしか出力されない状態です。
実行後のイメージは添付ファイルの通りです。
（A1、A2はデフォルトで入力しています。）
勉強を始めたばかりなので改善点もあれば、教えて頂きたいです。
よろしくお願い致します。
=================================================
Option Explicit
Sub pagecount()
Dim Page As Long, cnt As Long, xlcnt As Long
Dim fs As Variant, path As Variant
Dim Fname As String
Dim i As Integer
Dim wb1 As Workbook, wb2 As Workbook
Dim sh As Worksheet
With CreateObject("WScript.Shell")
.CurrentDirectory = ThisWorkbook.path
End With
fs = Application.GetOpenFilename(filefilter:="Microsoft Excelブック,*.xls*", MultiSelect:=True)
If IsArray(fs) Then
For Each path In fs
Set wb1 = Workbooks.Open(path, , True)
Set wb2 = ThisWorkbook
Do Until (Fname = "")
Page = 0
For Each sh In wb1.Worksheets
Page = Page + sh.PageSetup.Pages.Count
Next sh
xlcnt = Cells(Rows.Count, 1).Row
cnt = Cells(xlcnt, 1).End(xlUp).Row
If wb2.ActiveSheet.Cells(cnt, 1).Value <> "" Then
wb2.ActiveSheet.Cells(cnt, 1).Value = Fname
wb2.ActiveSheet.Cells(cnt, 1).Offset(0, 1) = Page
wb1.Close savechanges:=False
Fname = Dir()
cnt = cnt + 1
End If
Loop
Next path
End If
End Sub
