Excel VBA脚本-窃取焦点

我正在研究一个脚本，该脚本会定期对列表中的计算机执行ping操作并返回信息.

I'm working on a script that pings computers from a list periodically and returns information.

我的问题是，每当脚本运行时，它就会从其他excel窗口中窃取焦点.
例如，如果在脚本运行时我正在键入另一个工作簿，它将跳至(最后选择的单元格)并继续在该单元格中写入.

My problem is, whenever the the script is running, it steals focus from other excel windows.
For example if if I'm typing in another workbook when the scrip runs, it jumps (to the cell that was last selected) and continues writing in the cell.

这是脚本:

Sub autoping_cb()

Dim c As Range
Dim thePing As Variant
Dim TryCount As Integer
Dim TryAgainCount As Integer
Dim TryNextRun As Boolean

TryNextRun = False

Set sht = Application.ThisWorkbook.Worksheets(1)
LastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row

Dim chb As Shape
Set chb = ThisWorkbook.Worksheets(1).Shapes("autoping")

If chb.ControlFormat.Value = xlOn Then



sht.Range("H3").Value = Replace(sht.Range("H3").Value, ",", ".")


TryCount = 1

    If sht.Range("H4") <> "" And IsNumeric(sht.Range("H4")) = True And sht.Range("H4") = Int(sht.Range("H4")) And sht.Range("H3") <> "" And IsNumeric(sht.Range("H3")) = True Then
        TryAgainCount = sht.Range("H4").Value
            If TryAgainCount = 0 Then
                TryNextRun = True
            End If
        Do Until chb.ControlFormat.Value = xlOff            


            Wait ThisWorkbook.Worksheets(1).Range("H3").Value * 60 '<-- replace to 60 after testing

            For Each c In Application.Worksheets(1).Range("B3:B" & LastRow)
                    If chb.ControlFormat.Value = xlOff Then
                        End

                    ElseIf chb.ControlFormat.Value = xlOn Then
                        If ispcname(c.Value) = True Or isip(c.Value) = True Then
                            If c.Offset(0, 2) = "--->" And TryNextRun = False Then



                            Else
                                c.Offset(0, 1) = nslookup(c.Value)
                                thePing = sPing(c.Value)
                                c.Offset(0, 2) = thePing(0)
                                c.Offset(0, 3) = GetErrorCode(thePing(1))

                                If c.Offset(0, 2).Value = "--->" Then
                                    sht.Range("B" & c.Row & ":E" & c.Row).Style = "Bad"
                                ElseIf c.Offset(0, 2).Value < 50 Then
                                    sht.Range("B" & c.Row & ":E" & c.Row).Style = "Good"
                                Else
                                    sht.Range("B" & c.Row & ":E" & c.Row).Style = "Neutral"
                                End If

                            End If
                        End If


                    End If



                sht.Range("B2:E" & LastRow + 1).Columns.AutoFit
            Next c

        If TryNextRun = False And TryCount < TryAgainCount Then
            TryCount = TryCount + 1
            Debug.Print 1
        ElseIf TryNextRun = False And TryCount >= TryAgainCount Then
            TryNextRun = True
            TryCount = 1
            Debug.Print 2
        ElseIf TryNextRun = True And TryAgainCount <> 0 Then
            TryNextRun = False
            Debug.Print 3
        End If


        Loop

    Else
        MsgBox "invalid 'Ping every'/'try offline after' integer"
    End If

End If

End Sub

我知道这有点混乱:-)

It's a bit messy I know :-)