しなやか暮らし研究所パソコン処理 Excelの自動化インターアクション

インターアクション(対話処理）

表示関連

警告メッセージの非表示

Application.DisplayAlerts = False
    ActiveSheet.Delete
Application.DisplayAlerts = True

処理途中表示のOFF
処理途中表示のON

Application.ScreenUpdating = True
Application.ScreenUpdating = False

MsgBox、InputBox

Yes/Noを問う

Dim Ans As Integer
 
Ans = MsgBox ("処理を継続しますか?", vbYesNo)
 
定数の値と意味
vbOK　　　1 [OK]
vbCancel　2 [キャンセル]
vbAbort　 3 [中止]
vbRetry　 4 [再試行]
vbIgnore  5 [無視]
vbYes　　 6 [はい]
vbNo　　　7 [いいえ]

処理途中表示のOFF
メッセージを表示して、TIMEOUTで戻る

Option Explicit
Public Declare Function MessageBoxTimeoutA Lib "user32" _
                       (ByVal hWnd As Long, _
                        ByVal lpText As String, _
                        ByVal lpCaption As String, _
                        ByVal uType As Long, _
                        ByVal wLanguageId As Long, _
                        ByVal dwMilliseconds As Long) As Long
 
Sub TEST()
    Dim rtn As Long
    '第６引数が閉じる秒数 1000 で一秒です。
    rtn = MessageBoxTimeoutA(0&, "5秒後に閉じます。", "タイトル", vbYesNo, 0&, 5000)
End Sub

プロンプトを出して、入力を得る

Dim ans As String
 
ans = InputBox("入荷日=", "入荷日検索", "デフォルト入力")

その他

Excelのセルを使って初期設定を行う

InputBook = Range("B1").Value
InputPath = Range("B2").Value
NeedPrint = Range("B7").Value

文字の読み上げ

Application.Speech.Speak "電子メールを受信しました"
 
XPでは英語のみ、Vistaは日本可
この機能を利用するために、XPでは次の2本のRuntimeをExcelに組み込まなければいけない。
Microsoft Speech Platform - Server Runtime (Version 10.2)
Microsoft Speech Platform - Server Runtime Languages (Version 10.2)

セル内容の読み上げ

Range("A1:A4").Speak

数字を2ケタづつに分けて読む

Number = Cells(K, 2).Value
Count = Len(Number)
L = 1
M = 2
Do While L <= Count
    If Count - L <= 0 Then M = 1
    Letter = Mid(Number, L, M)
    Application.Speech.Speak Letter
    L = L + M
Loop

C:\Sample.txtの内容を1行ずつ読み上げ

Sub Sample4()
    Dim buf As String
    Open "C:\Sample.txt" For Input As #1
        Do Until EOF(1)
            Line Input #1, buf
            Application.Speech.Speak buf
        Loop
    Close #1
End Sub

ビープ音を鳴らす

Beep
 
ただし、二回以上鳴らす場合はBeepの後でタイマー待ちを取る
Beep
    Application.Wait [Now() + "0:00:0.1"]
Beep

警告メッセーを非表示にする

ブックのオープン、シートの削除だけでなく、シートをコピー/ペーストした場合でも下記のような警告メッセージが出て、処理が中断されるので警告メッセージが出る可能性のあるところでは、処理を止めないために必ずメッセージを非表示にしておく必要がある。

Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

エラー処理 - MsgBoxのウインドウアイコン変更

エラー処理の飛び先はそのプロシージャ内のみ。プロシージャ毎に記述要。

On Eerror GoTo ErrorHandler
 
Exit Sub
 
ErrorHandler:
MsgBox "処理が完了しませんでした。" & vbCrLf & "問題を解決して、再度処理を実行してください。" _
, vbExclamation, "TEST2"
 
End Sub


MsgBoxのアイコン変更は第2引数
vbExclamation　　「注意」の黄色アイコン
vbCritical　　　 「停止」の赤いアイコン
vbInformation　　「案内」アイコン
タイトルの変更は第3引数に文字列指定

エラー処理 - エラー対策を組込む

ErrorHandlerの中でエラーの対処を行い、処理を続行する

Option Explicit
'*******************************************************************************
' エラー表記を独自にコントロールする例②
'*******************************************************************************
Sub TEST3()
    Dim vrnINPUT As Variant
    Dim intNUM As Integer
 
    vrnINPUT = "a"          ' 入力データ
    On Error GoTo ERR2
    intNUM = vrnINPUT
    MsgBox "結果は" & intNUM & "で正常終了しました。"
    Exit Sub
 
'-------------------------------------------------------------------------------
' エラー時の飛び先(行ラベル)
ERR2:
    If MsgBox("実行時エラー:" & Err.Number & " " & _
        Err.Description & vbCr & _
        "入力データは「" & vrnINPUT & "」です。ゼロに置き換えますか？", _
        vbExclamation + vbYesNo, "TEST3") = vbYes Then
        ' ゼロを上書き
        intNUM = 0
        ' エラー発生箇所の次に進める
        Resume Next
    End If
 
End Sub


ErrorHandlerからの戻りは2種類
Resume 　　　：元の行に戻る
Resume Next　：元の次の行に戻る

選択されたセル（1列複数行）を順に上から読み上げる

Sub Sample1()
 
    Dim RowCnt, ColCnt, StartRow, StartColumn As Integer
    Dim Max_Row, Max_Column As Integer
    Dim LoopArea As Range
    Dim SelectArea As String
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
     
    SelectArea = Selection.Address
     
    RowCnt = Selection.Row
    ColCnt = Selection.Column
 
    Set LoopArea = Selection
     
    StartRow = LoopArea.Cells(1).Row
    StartColumn = LoopArea.Cells(1).Column
     
    Max_Row = LoopArea.Cells(LoopArea.Count).Row
    Max_Column = LoopArea.Cells(LoopArea.Count).Column
     
    K = StartRow
    FinalEnd = False
     
    Do
        For I = 1 To 5
            Application.Speech.Speak Cells(K, StartColumn).Value
            K = K + 1
            If K > Max_Row Then
                FinalEnd = True
                Exit For
            End If
        Next I
        If FinalEnd = True Then Exit Do
        J = MsgBox("続けますか？", vbYesNo)
    Loop While J = vbYes
     
End Sub

5 6 7