しなやか暮らし研究所パソコン処理 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("入荷日=", "入荷日検索", "デフォルト入力")

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