総合演習 - サンプルコード5日目 - 自由が丘のマクロ少女～妹に教えてもらう！ExcelVBA講座～

モジュール共通部分

Option Explicit
'**************************************************************
'Day5.総合演習
' (1)連続的な画面遷移を行う
' (2)オンライン画面のデータをワークシートに一覧化する
' (3)ワークシート一覧データをオンライン画面に登録する
'**************************************************************

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

(1)連続画面遷移

'サンプル5.1.1_連続画面遷移
Public Sub navigate1To3()
    Dim ie As InternetExplorer
    Dim Anchor As HTMLAnchorElement
    'IE起動
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    '画面1を開いて待ち受け
    ie.Navigate2 "http://macrogirls.net/sample/screen1.html"
    Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE
        DoEvents
    Loop
    Sleep 2000  '動作を見るために2秒待ち（動作上は不要）
    'リンクをクリックして画面2へ移動＆待ちうけ
    For Each Anchor In ie.document.getElementsByTagName("A")
        If Anchor.innerText = "画面2へ進む" Then
            Anchor.Click
            Exit For
        End If
    Next
    Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE
        DoEvents
    Loop
    Sleep 2000  '動作を見るために2秒待ち（動作上は不要）
    'ボタンをクリックして画面3へ移動＆待ちうけ
    ie.document.forms("TargetForm").elements("toScreen3").Click
    Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE
        DoEvents
    Loop
End Sub

(2)連続画面遷移（開いた子画面の待ちうけ）

'サンプル5.1.2_連続画面遷移（開いた子画面の待ちうけ）
Public Sub waitChild()
    Dim ie As InternetExplorer
    Dim ieChild As InternetExplorer
    'IE起動→サンプル親画面に遷移
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.Navigate2 "http://macrogirls.net/sample/parent.html"
    '待ちうけ
    Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE
        DoEvents
    Loop
    '子画面を開くボタンをクリック
    ie.document.forms("TargetForm").elements("OpenChild").Click
    '子画面を探す
    Do While ieChild Is Nothing
        Set ieChild = Day2.getIE("子画面の例")
        DoEvents
    Loop
    '子画面の待ちうけ（ただしgetIEでDocumentを参照しており、基本的には不要）
    Do While ieChild.Busy Or ieChild.ReadyState < READYSTATE_COMPLETE
        DoEvents
    Loop
    Debug.Print ieChild.document.body.innerHTML
End Sub

(3)オンライン画面のデータをワークシートに一覧化する

'サンプル5.2.1_オンライン画面のデータをワークシートに一覧化する
Public Sub お客さまデータ一覧化()
    Dim ie As InternetExplorer
    Dim AllAnchors As Object
    Dim i, NextIndex, printrow As Integer
    'IE起動→オンライン画面へ遷移→一覧画面へ遷移
    Set ie = getOnline
    ie.document.frames("Footer").document.forms("Commands").elements("ShowList").Click
    waitNavigation ie
    '画面に対して処理（次の画面がある限り処理）
    printrow = 3
    Do
        NextIndex = -1   '次の画面へのAタグインデックス値をリセット
        'すべてのAタグに対して処理（インデックスを利用）
        For i = 0 To ie.document.frames("Main").document.getElementsByTagName("A").Length - 1
            'Aタグコレクションへの参照を格納（再格納）
            Set AllAnchors = ie.document.frames("Main").document.getElementsByTagName("A")
            'Cを含むリンクの場合クリックしてお客さま情報へ遷移
            If InStr(AllAnchors(i).href, "C") > 0 Then
                AllAnchors(i).Click
                waitNavigation ie
                'お客さま情報のシート転記
                printCustomerData ie, printrow
                printrow = printrow + 1
            '次の画面へのリンクの場合はインデックスを保管しておく
            ElseIf InStr(AllAnchors(i).innerText, "次へ") > 0 Then
                 NextIndex = i
            End If
        Next
        '次のページに遷移
        If NextIndex >= 0 Then
            ie.document.frames("Main").document.getElementsByTagName("A")(NextIndex).Click
            waitNavigation ie
        End If
        DoEvents
    '次の画面へ遷移している場合はループ
    Loop While NextIndex >= 0
End Sub

'サンプル5.2.2_詳細画面転記処理
Private Sub printCustomerData(ie As InternetExplorer, printrow As Integer)
    Dim Anchor As HTMLAnchorElement
    Dim TDs As Object
    Dim i As Integer
    Dim CID, CName, CAddress, CMagic, CFamiliar, SalesDept As String
    'すべてのTDタグを評価し、取得対象項目のデータを変数に格納
    Set TDs = ie.document.frames("Main").document.getElementsByTagName("TD")
    For i = 0 To TDs.Length - 1
        Select Case Trim(TDs(i).innerText)
            Case "お客さまID": CID = TDs(i + 1).innerText
            Case "氏名": CName = TDs(i + 1).innerText
            Case "住所": CAddress = TDs(i + 1).innerText
            Case "魔法": CMagic = TDs(i + 1).innerText
            Case "使い魔": CFamiliar = TDs(i + 1).innerText
            Case "営業担当": SalesDept = TDs(i + 1).innerText
        End Select
    Next
    '取得データをワークシートに転記
    Sheet2.Cells(printrow, 1).Value = CID
    Sheet2.Cells(printrow, 2).Value = CName
    Sheet2.Cells(printrow, 3).Value = CAddress
    Sheet2.Cells(printrow, 4).Value = CMagic
    Sheet2.Cells(printrow, 5).Value = CFamiliar
    Sheet2.Cells(printrow, 6).Value = SalesDept
    '一覧画面に戻る
    For Each Anchor In ie.document.frames("Main").document.getElementsByTagName("A")
        If InStr(Anchor.innerText, "戻る") > 0 Then
            Anchor.Click
            waitNavigation ie
            Exit Sub
        End If
    Next
End Sub

(4)ワークシート一覧データをオンライン画面に登録する

'5.3_ワークシート一覧データをオンライン画面に登録する
Public Sub 一覧データオンライン登録()
    Dim ie As InternetExplorer
    Dim i As Integer
    'IE起動→オンライン画面へ遷移
    Set ie = getOnline
    '各レコードを登録
    i = 3
    Do While Sheet2.Cells(i, 1) <> ""
        '新規登録画面へ遷移
        ie.document.frames("Footer").document.forms("Commands").elements("Register").Click
        waitNavigation ie
        'レコードデータをフォームに貼り付け・送信
        With ie.document.frames("Main").document.forms("RegData")
            .elements("CustomerID").Value = Sheet2.Cells(i, 1)
            .elements("CustomerName").Value = Sheet2.Cells(i, 2)
            .elements("Address").Value = Sheet2.Cells(i, 3)
            .elements("Magic").Value = Sheet2.Cells(i, 4)
            .elements("Familiar").Value = Sheet2.Cells(i, 5)
            .elements("SalesDepartment").Value = Sheet2.Cells(i, 6)
            .submit
        End With
        waitNavigation ie
        i = i + 1
        DoEvents
    Loop
End Sub

総合演習で利用する汎用処理

'サンプルオンラインシステム起動処理
Private Function getOnline() As InternetExplorer
    Dim ie As InternetExplorer

    'IE起動→オンライン画面へ遷移
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.Navigate2 "http://macrogirls.net/sample/webonline.html"
    waitNavigation ie
    
    Set getOnline = ie
End Function

'サンプルオンラインシステム汎用待ちうけ処理
Private Sub waitNavigation(ie As InternetExplorer)
    Dim i As Integer
    'IE待ちうけ
    Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE
        DoEvents
    Loop
    'フレームセットのドキュメント待ちうけ
    Do While ie.document.ReadyState <> "complete"
        DoEvents
    Loop
    'フレーム内のドキュメント待ちうけ
    For i = 0 To ie.document.frames.Length - 1
        Do While ie.document.frames(i).document.ReadyState <> "complete"
            DoEvents
        Loop
    Next
End Sub

総合演習 - サンプルコード5日目

もくじ

モジュール共通部分

(1)連続画面遷移

(2)連続画面遷移（開いた子画面の待ちうけ）

(3)オンライン画面のデータをワークシートに一覧化する

(4)ワークシート一覧データをオンライン画面に登録する

総合演習で利用する汎用処理