三流君 ken3のmemo置き場

メモ置き場、保管庫として利用。まとまっていませんがヨロシク

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
(※詳細は[三流君 三流プログラマーとは?]を見てください)


広告:


[記事一覧、バックナンバーを見る]

Excel Formから起動済みのIEを選択 Bodyの値を取得するテスト

XXXXXさんより、下記の質問が来ました。

> 【VBA IE操作】テーブル単体を取り出す  にて勉強中の老人です。
> 上記サンプルはURLを記述して表示して
>WEBページにテーブルの内容を取得しておりますが、
>当方も目的はページを次から次に切り替えて
>その都度にテーブルの内容をEXCLEに蓄積したいと思っ
> てます。(手動で開いたページのテーブル等)

と、
既存IEを手動で操作して、データを抜く、
そんな質問が来たので、
初めの一歩として、

今回は、テストで起動済みのIEを探し、
グローバル変数に入れておき、
コンボボックスで選択
Bodyタグの テキストとHTMLをテストで表示してみます。

いつもの 酔っ払い フラフラ解説動画・・・
Excel VBA UserForm から起動済みのIEを選択 Bodyの値を取得するテスト【三流君】 - YouTube
www.youtube.com

過去に作成した
ken3memo.hatenablog.com

Sub aaa()

    'オブジェクトを格納する変数
    Dim objShell As Object, objWindow As Object

    'シェルのオブジェクトを作成する
    Set objShell = CreateObject("Shell.Application")
    
    'ウインドウの数だけまわすぞ
    For Each objWindow In objShell.Windows
        'TypeNameでオブジェクト変数のタイプを表示する
        MsgBox "タイプは:" & TypeName(objWindow.document)
        Debug.Print "タイプは:" & TypeName(objWindow.document)
        'HTMLDocumentだったら
        If TypeName(objWindow.document) = "HTMLDocument" Then
            'URLとタイトルを表示する
            MsgBox "IEみつけたよ" & objWindow.document.Title
            Debug.Print "タイトル:" & objWindow.document.Title
            Debug.Print "URL:" & objWindow.document.URL
        End If
    Next
    Set objShell = Nothing

End Sub

↑を参考に

コンボボックスにIEタイトルとURLをセット、
ついでに
グローバル変数に見つけたIEオブジェクトをセットする
Dim IE As InternetExplorer
Dim IE_BOX(10) As Object ←ここにセット、保管してみる

Private Sub btnIE探す_Click()
    'オブジェクトを格納する変数
    Dim objShell As Object, objWindow As Object
    Dim n As Integer

    Me.cbIELIST.Clear  '選択用のコンボボックスをクリア、初期化

    'シェルのオブジェクトを作成する
    Set objShell = CreateObject("Shell.Application")
    
    'ウインドウの数だけまわすぞ
    n = 0
    For Each objWindow In objShell.Windows
        'TypeNameでオブジェクト変数のタイプを表示する
        Debug.Print "タイプは:" & TypeName(objWindow.document)
        'HTMLDocumentだったら
        If TypeName(objWindow.document) = "HTMLDocument" Then
            'URLとタイトルをコンボボックスへ追加
            Me.cbIELIST.AddItem "IE(" & n & "):Title=" & objWindow.document.Title & "):URL=" & objWindow.document.Url
            Debug.Print "タイトル:" & objWindow.document.Title
            Debug.Print "URL:" & objWindow.document.Url
            'IEを保存 代入する
            Set IE_BOX(n) = objWindow   '配列に保存しておく
            'nカウンタを増やす
            n = n + 1
            If n = 9 Then Exit For  'MAX9個までとする
        End If
    Next
    Set objShell = Nothing

End Sub

↑で、
IE_BOX(10) に オブジェクト

コンボボックス cbIELIST に タイトルとURL
を保存して、

コンボボックスが変わったイベントで、

'コンボボックスでIEが選択されたら
Private Sub cbIELIST_Change()

    Debug.Print Me.cbIELIST.ListIndex & "番目を選択"
    
    '未選択のチェック
    If Me.cbIELIST.ListIndex = -1 Then
        Me.Caption = "未選択 IEを選択してください" 'Formタイトルバーに未選択を表示
        Exit Sub  '関数を途中で抜ける
    End If
    
    '選択されたら、
    Set IE = IE_BOX(Me.cbIELIST.ListIndex) '選択されたn番目のIEを代入する
    
    Me.Caption = Me.cbIELIST.Text  '選択されたコンボボックス値をFormタイトルへ
    Me.txtINFO.Text = Me.cbIELIST.Text & " を 選択しました"
    
End Sub

'選択されたら、
Set IE = IE_BOX(Me.cbIELIST.ListIndex) '選択されたn番目のIEを代入する
で、指定してもらい、

テストのボタン

Private Sub btnBODY_InnerTEXT_Click()
    
    Dim objBODY As HTMLBody
    
    If IE Is Nothing Then Exit Sub  'IEの中身が無ければ関数を抜ける
    
    Set objBODY = IE.document.body  'Document.Bodyを変数に代入
    
    Me.txtINFO.Text = objBODY.innerText   '.Innertxtの値をテキストボックスへ

End Sub

Private Sub btnBODY_OuterHTML_Click()
    Dim objBODY As HTMLBody
    
    If IE Is Nothing Then Exit Sub  'IEの中身が無ければ関数を抜ける
    
    Set objBODY = IE.document.body  'Document.Bodyを変数に代入
    
    Me.txtINFO = objBODY.outerHTML  '.outerHTMLの値をテキストボックスへ

End Sub

↑BODYのInnerTEXT と OuterHTMLをセットしてみました。


完成したソース・・・

Dim IE As InternetExplorer
Dim IE_BOX(10) As Object

Private Sub btnBODY_InnerTEXT_Click()
    
    Dim objBODY As HTMLBody
    
    If IE Is Nothing Then Exit Sub  'IEの中身が無ければ関数を抜ける
    
    Set objBODY = IE.document.body  'Document.Bodyを変数に代入
    
    Me.txtINFO.Text = objBODY.innerText   '.Innertxtの値をテキストボックスへ

End Sub

Private Sub btnBODY_OuterHTML_Click()
    Dim objBODY As HTMLBody
    
    If IE Is Nothing Then Exit Sub  'IEの中身が無ければ関数を抜ける
    
    Set objBODY = IE.document.body  'Document.Bodyを変数に代入
    
    Me.txtINFO = objBODY.outerHTML  '.outerHTMLの値をテキストボックスへ

End Sub

'コンボボックスでIEが選択されたら
Private Sub cbIELIST_Change()

    Debug.Print Me.cbIELIST.ListIndex & "番目を選択"
    
    '未選択のチェック
    If Me.cbIELIST.ListIndex = -1 Then
        Me.Caption = "未選択 IEを選択してください" 'Formタイトルバーに未選択を表示
        Exit Sub  '関数を途中で抜ける
    End If
    
    '選択されたら、
    Set IE = IE_BOX(Me.cbIELIST.ListIndex) '選択されたn番目のIEを代入する
    
    Me.Caption = Me.cbIELIST.Text  '選択されたコンボボックス値をFormタイトルへ
    Me.txtINFO.Text = Me.cbIELIST.Text & " を 選択しました"
    
End Sub

Private Sub btnIE探す_Click()
    'オブジェクトを格納する変数
    Dim objShell As Object, objWindow As Object
    Dim n As Integer

    Me.cbIELIST.Clear  '選択用のコンボボックスをクリア、初期化

    'シェルのオブジェクトを作成する
    Set objShell = CreateObject("Shell.Application")
    
    'ウインドウの数だけまわすぞ
    n = 0
    For Each objWindow In objShell.Windows
        'TypeNameでオブジェクト変数のタイプを表示する
        Debug.Print "タイプは:" & TypeName(objWindow.document)
        'HTMLDocumentだったら
        If TypeName(objWindow.document) = "HTMLDocument" Then
            'URLとタイトルをコンボボックスへ追加
            Me.cbIELIST.AddItem "IE(" & n & "):Title=" & objWindow.document.Title & "):URL=" & objWindow.document.Url
            Debug.Print "タイトル:" & objWindow.document.Title
            Debug.Print "URL:" & objWindow.document.Url
            'IEを保存 代入する
            Set IE_BOX(n) = objWindow   '配列に保存しておく
            'nカウンタを増やす
            n = n + 1
            If n = 9 Then Exit For  'MAX9個までとする
        End If
    Next
    Set objShell = Nothing

End Sub

Private Sub btn閉じる_Click()
    Unload Me       '自分自身を閉じる
End Sub

↑こんな感じで、小細工ですが、既存のIEからデータを抜けそうです。
次回は、テーブルを指定して、
さらに絞り込みたいと思っていますが・・・
先は長いかなぁ・・・

サンプルファイルは
http://ie.vba-ken3.jp/test/Book20170807.zip
に保存しておきました。アレンジして使ってみてください。

何かの参考となれば、幸いです。 三流プログラマー Ken3

テスト JRA単勝オッズをレース別に複数蓄積する

単勝オッズをレース別 取得時間別にためていきたいと思います
f:id:ken3memo:20170805161714j:plain

現在、最新のオッズを取得するところまでは、
バグ付きですがなんとかできました。

ここから、分岐して、
単勝オッズが時間の経過でどのように推移するか?
そんな分析をしたいので、
レース別 時間別にシートに保存、
そんな処理を行ってみたいと思います。

下記、↓いつもの迷っている ライブ動画です・・・
JRA単勝オッズをレース別に複数蓄積する VBA IE操作 Ken3 ライブ プログラミング テスト中 - YouTube
www.youtube.com

ポイントは、
単勝順のオッズを一時的に
Sheets("作業用")
に書き込む

次に、
1.初回は、馬番 馬の名前を書き込む
2.二回目以降は、時刻とオッズを書き込む
上記をポイントに処理を行ってみたいと思います。

初回のチェックは、
一枠一番の馬名が変化したかを単純にチェックしました。
あとは、単純にデータを作業用シートからレース1R..12Rにコピーしただけです。

            '初回か判断 レース場や開催日が変わっているか 馬名で判断
            
            If Sheets("作業用").Range("C3") <> Range("C3") Then  'C3馬名が違ったら
                'シートをクリア
                Cells.Delete Shift:=xlUp 'シート全体を削除する
                Range("A1").Select       '先頭A1を選択する、
                '初回は、馬名もコピーする
                Sheets("作業用").Range("A1:D20").Copy
                Range("A1").Select
                ActiveSheet.Paste
                'オッズの時刻をセット
                Sheets("作業用").Range("B1").Copy
                Range("D2").Select
                ActiveSheet.Paste
            Else
                '二回目以降は、後ろに追記
                '元データをコピー
                Sheets("作業用").Range("D2:D20").Copy  'オッズの列
                '貼り付け先を探す
                For x = 1 To 256  '空白列を探す
                    'セル二行目のx列が空白か調べて抜ける
                    If Len(Trim("" & Cells(2, x))) = 0 Then Exit For
                Next x
                Cells(2, x).Select '貼り付け先を選択
                ActiveSheet.Paste
                '時刻を貼り付ける
                Sheets("作業用").Range("B1").Copy
                Cells(2, x).Select '貼り付け先を選択
                ActiveSheet.Paste
            End If

↑上記のような 単純なコードですみません・・・・


頭からの 長いソースは、

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

'IEオブジェクトを受け取り、表示を待つ
Sub IE_WAIT(objIE As InternetExplorer)

    Sleep 250  '0.25秒待つ

    'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        'DoEvents  '重いので嫌いな人居るけど。
        Sleep 200  '0.2秒待つ
    Wend

    Sleep 250  '0.25秒待つ

End Sub


'IEのリンクオブジェクトから文字列をInStrで探してクリックする
Sub IE_Link_InnerHTML_InStr_Click(objIE As InternetExplorer, strINSTR As String)

    Dim i As Integer
    Dim objA As HTMLAnchorElement

    'リンクから受け取った文字列を探して押す
    For i = 0 To objIE.Document.Links.Length - 1
        '文字列を見つけたら クリック
        If InStr(objIE.Document.Links(i).innerHTML, strINSTR) > 0 Then '内側のHTML
            Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
            objA.Click   '該当するリンクを押す
            'objA.FireEvent ("onClick")  'onClick イベントを発行
            Exit For '見つけたのでループを抜ける
        End If
    Next i

End Sub


Public Function JRA_Bodyからオッズの時刻を返す(objIE As InternetExplorer) As String

    Dim strTEMP As String
    Dim strRETURN As String  'リターン値
    Dim n As Integer
    
    'errでリターン値を初期化
    strRETURN = "ERR 文字列が見つかりませんでした"
    
    'HTMLのBODYテキストを代入
    strTEMP = objIE.Document.body.innerText

    'まず最終オッズを探す
    If InStr(strTEMP, "最終オッズ") > 0 Then
        strRETURN = "最終"
    End If

    'XX現在を探す
    n = InStr(strTEMP, "現在オッズ")
    If n > 0 Then
        strRETURN = Mid(strTEMP, n - 5, 5)  '時刻を取り出す
    End If

    'リターン値をセット
    JRA_Bodyからオッズの時刻を返す = strRETURN

End Function

Sub ie_JRA単勝オッズをレース別に複数蓄積する()  'JRA 単勝オッズの取り込み 馬番順テスト

'IEの起動
    Dim objIE As InternetExplorer '変数を定義します。
    Set objIE = CreateObject("InternetExplorer.Application") 'オブジェクトを作成します。
    objIE.Visible = True      '可視、Trueで見えるようにします。
    
'表示位置(左上の座標)とサイズ(高さ・幅)を調整する
    objIE.FullScreen = False '※Trueのモードだとびっくりするよ
    objIE.Top = 0      '左上 上位置
    objIE.Left = 0     '左上 左位置
    objIE.Width = 800    '横幅
    objIE.Height = 600   '高さ
    
'XXXバー、外観・外枠の調整。
    objIE.Toolbar = True     'タブの切り替えで必要なので、ツールバーを表示にする
    objIE.MenuBar = False    'メニューは非表示にする
    objIE.AddressBar = True  'URLなど アドレスバーは確認のため、表示する
    objIE.StatusBar = True   '一番下のステータスバーを表示。

'JRA TOP ページの表示
    '処理したいページを表示します。
    objIE.Navigate "http://www.jra.go.jp/"  '.Navigate メソッドで JRA表示する。

    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
    
'TOPページが表示されたので、表示された文章に対して、処理を行います。
       
    Dim i     As Integer '添え字 i番目などで使用
    Dim yLINE As Integer '行カウンタ、Y行目
    
    Dim oDocument As HTMLDocument
    Dim objA As HTMLAnchorElement

    Dim objTABLEs As Object 'TABLE複数の格納用
    Dim objTABLE As HTMLTable 'テーブル単体
    
    Dim x As Integer  '列の管理
    Dim y As Integer  '行の管理
    
    Dim SET_Y As Integer  'Excel側のセット位置
    Dim SET_X As Integer  'Excel側のセット位置
    
    Dim objCELL As HTMLTableCell

    Dim nRACE As Integer   'レース 1-12
    Dim strRACE As String  '文字列 1Rなどを作るため


'リンクからオッズを押す
    Call IE_Link_InnerHTML_InStr_Click(objIE, "オッズ")
    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。


    '開催日のリンクをあさる
    Set objA = Nothing
    For i = 0 To objIE.Document.Links.Length - 1
        '開催場所 B2と一致を条件に判断する
        If objIE.Document.Links(i).innerText = Sheets("MENU").Range("B2") Then '内側のTEXT
           Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
           objA.Click   '開催日を押す
           Exit For '見つけたのでループを抜ける
        End If
    Next i
    
    If objA Is Nothing Then
        MsgBox Sheets("MENU").Range("B2") & " リンクが見つかりませんでした"
        Exit Sub
    End If

    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。

'1R-12R 単勝の表を取り込む
    
    '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ
    For nRACE = 1 To 12  '一から十二まで
        'B5からのフラグが立っていたらレースを取り込む
        If Sheets("MENU").Range("B4").Offset(nRACE, 0) = 1 Then
        
            '出力先をクリアする
            'まず、書き込み先シート、データをクリアする
            'Sheets(nRACE & "R").Select  'シートの切り替え
            Sheets("作業用").Select  'シートの切り替え
            Cells.Delete Shift:=xlUp 'シート全体を削除する
            Range("A1").Select       '先頭A1を選択する、
            SET_Y = 0  'セット位置を初期化
        
            strRACE = nRACE & "R"   'R1など 文字にする
        
            'リンクから該当するレースを探しクリックする "1R".."12R"
            Call IE_Link_InnerHTML_InStr_Click(objIE, """" & strRACE & """")
            Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
        
            'レース番号をセルに書く
            SET_Y = SET_Y + 1
            Cells(SET_Y, 1) = Sheets("MENU").Range("B2") & " " & strRACE
            Cells(SET_Y, 2) = JRA_Bodyからオッズの時刻を返す(objIE)
            Sheets("MENU").Range("B4").Offset(nRACE, 1) = JRA_Bodyからオッズの時刻を返す(objIE)
            Debug.Print JRA_Bodyからオッズの時刻を返す(objIE)
            
            SET_Y = SET_Y + 1
        
            '単勝の表を取り込む
            '表、テーブルを探る
            'テーブルを探す
            'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
            
            'TABLEタグを抜き 複数のテーブルをセット
            Set objTABLEs = objIE.Document.getElementsByTagName("TABLE")
            '↑で代入したオブジェクトからテーブルデータを取り出す。
            
            Set objTABLE = Nothing  'オブジェクトを空にする
            For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
                If objTABLEs(i).Rows(0).Cells(0).innerText = "枠番" Then '左上が枠番を見つける
                    Set objTABLE = objTABLEs(i)  'i盤目を代入
                    Exit For
                End If
            Next i
            
            '↑で見つかったかチェックする
            If objTABLE Is Nothing Then
                MsgBox "枠番のテーブルが見つかりません"
                Exit Sub  'エラー表示して抜ける
            End If
            
            
            '表をDATAシートに書き出す
            
            'Webの表をシートへ転記(代入する)
            For y = 0 To objTABLE.Rows.Length - 1  '行のループ
                SET_X = 1
                For x = 0 To objTABLE.Rows(y).Cells.Length - 1  '列数分ループ
                    ' objTABLE.rows(行).cells(列)
                    Set objCELL = objTABLE.Rows(y).Cells(x)
                    
                    '結合セル、枠などに対応
                    If objCELL.rowSpan > 1 Then  '縦に複数の時
                        Cells(SET_Y + 1, SET_X) = objCELL.innerText  '下にも同じくセット
                        'ホントはループがいいけど、一枠に三頭までなので
                        If objCELL.rowSpan = 3 Then  '3頭め 8枠18番など・・
                            Cells(SET_Y + 2, SET_X) = objCELL.innerText
                        End If
                    End If
                                
                    '既にデータありか、縦に結合されているか?
                    If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then
                        SET_X = SET_X + 1  '縦結合を飛ばすために横に移動
                    End If
                    
                    Cells(SET_Y, SET_X) = objCELL.innerText  'データセット
                    
                    '横に結合されているか判断じゃなかった、横にカラム分移動
                    SET_X = SET_X + objCELL.colSpan  '横に移動 通常は1 結合なし
                Next
                SET_Y = SET_Y + 1
            Next
            SET_Y = SET_Y + 1  '空白を一行追加
            
            '作業用シートからレース別に転記する
            Sheets(nRACE & "R").Select  'シートの切り替え

            '初回か判断 レース場や開催日が変わっているか 馬名で判断
            
            If Sheets("作業用").Range("C3") <> Range("C3") Then  'C3馬名が違ったら
                'シートをクリア
                Cells.Delete Shift:=xlUp 'シート全体を削除する
                Range("A1").Select       '先頭A1を選択する、
                '初回は、馬名もコピーする
                Sheets("作業用").Range("A1:D20").Copy
                Range("A1").Select
                ActiveSheet.Paste
                'オッズの時刻をセット
                Sheets("作業用").Range("B1").Copy
                Range("D2").Select
                ActiveSheet.Paste
            Else
                '二回目以降は、後ろに追記
                '元データをコピー
                Sheets("作業用").Range("D2:D20").Copy  'オッズの列
                '貼り付け先を探す
                For x = 1 To 256  '空白列を探す
                    'セル二行目のx列が空白か調べて抜ける
                    If Len(Trim("" & Cells(2, x))) = 0 Then Exit For
                Next x
                Cells(2, x).Select '貼り付け先を選択
                ActiveSheet.Paste
                '時刻を貼り付ける
                Sheets("作業用").Range("B1").Copy
                Cells(2, x).Select '貼り付け先を選択
                ActiveSheet.Paste
            End If
            
        End If  'フラグが立っていたら↑
        
    Next

    
    objIE.Quit  '.Quitで閉じる
    Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。
   
End Sub

です。

まだまだ、先は長い感じですが、
たたき台、サンプルとして使い、
自由にアレンジしてみてください。。。。

クリップボード から テキスト取得して選択セルに追記してみた

人力検索↓で久々に回答してみた。
q.hatena.ne.jp
※中途半端なコードなのにOKをもらってしまった。

VBA クリップボードで検索する
とイロイロなページがヒットします。
ExcelのVBAで、クリップボードのデータ形式を確認する。〜パソコンの小技・備忘録
Office TANAKA - Excel VBA Tips[クリップボードを操作する(1)]
クリップボードとデータのやりとりをする:Excel VBA|即効テクニック|Excel VBAを学ぶならmoug

上記を参考にして、

参照設定で
Microsoft Forms 2.0 Object Library
と言われるが、見つからない ぉぃぉぃ

で、フォームを挿入すると簡単と書いてあったので、
一つフォームを挿入する

参照設定だけ、下記の動画を見てください。
Excel VBA クリップボード 複数選択セルに貼り付け はてな 回答 テスト動画 2017/08/02 【三流君】 - YouTube
www.youtube.com
↑参照設定とテスト動画。

Sub はてな回答テスト20170802()

    Dim CB As Variant 'クリップボードにはさまざまな形式なので
    Dim strADDTEXT As String  'クリップボードから追記するテキスト保管
    Dim selectRANGE As Range  '選択範囲
    Dim n As Integer  'N番目
    Dim y As Integer  '行
    Dim x As Integer  '列
    
    'クリップボード内のデータ種類を判断
    CB = Application.ClipboardFormats
    
    If CB(1) = -1 Then
        Debug.Print "クリップボードには何も入っていません。"
        Exit Sub
    End If

    'テキスト形式か?
    If CB(1) = xlClipboardFormatText Then
        'テキストデータを取り出す
        With New MSForms.DataObject
            .GetFromClipboard    ''変数のデータをDataObjectに格納する
            strADDTEXT = .GetText 'テキストを取得
            Debug.Print strADDTEXT
            '選択されているセルに対して処理を行う
            Set selectRANGE = ActiveWindow.Selection
            '複数セル、範囲もあるのでループさせる
            For n = 1 To selectRANGE.Areas.Count  '※nは1から
                'セルが範囲選択されている可能性があるので、
                Debug.Print n & " " & selectRANGE.Areas(n).Address
                Debug.Print selectRANGE.Areas(n).Rows.Count
                Debug.Print selectRANGE.Areas(n).Columns.Count
                For y = 1 To selectRANGE.Areas(n).Rows.Count  '行のループ
                    For x = 1 To selectRANGE.Areas(n).Columns.Count '列のループ
                        Debug.Print selectRANGE.Areas(n).Cells(y, x).Address
                        Debug.Print selectRANGE.Areas(n).Cells(y, x).Value
                        selectRANGE.Areas(n).Cells(y, x).Value = selectRANGE.Areas(n).Cells(y, x).Value & strADDTEXT
                    Next x
                Next y
            Next n
        End With
    End If

End Sub

↑のコードを貼り付けて、テストしてみてください。
Debug.Print は 必要ないので、消してください。

動画の後半で、テスト時、Excelのセルをコピーしてクリップボードに入れた場合、
テキストとして 反応しないので、バグってます。

参照設定だけ、下記の動画を見てください。
※冒頭の動画と一緒です・・・
www.youtube.com
↑参照設定とテスト動画。




三流君へ メッセージを送る

全ての質問に答えることはできませんが、
ダメもとで、気軽に質問、感想、メッセージを送ってくださいね・・・

感想や質問・要望・苦情など 三流君へメッセージを送る。
下記のフォームからメッセージを送ることができます。


あなたのお名前(ニックネーム):さん
返信は?:

アドレス:に返事をもらいたい
感想や質問↓:


(感想や質問・要望・苦情はHPで記事に載せることがあります。)
例:[XXXXさんへ回答例]←みたいに回答していたり...


Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。
・[Excel/Access VBA]の解説
・[ASP(Active Server Pages)]の解説。
・[元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
・[プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
三流君を踏み台にする
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。

三流解説動画の再生リスト
https://www.youtube.com/user/ken3video/playlists

本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)