Ping单个单元格

时间:2017-06-03 10:35:08

标签: excel excel-vba vba

嗨大家我一直在制作一个活动单元格ping并输出结果时遇到问题我有完整列的代码但是我想创建一个只做一个选定单元格的按钮并让它以同样的方式工作有谁能够帮我 ? 这是我在网上找到的代码,我不确定如何为一个单元格修改它我曾多次尝试过但没有成功......

    Function GetPingResult(checkip)

   Dim objPing As Object
   Dim STATUS As Object
   Dim Result1 As String

   Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
       ExecQuery("Select * from Win32_PingStatus Where Address = '" & checkip & "'")

   For Each objStatus In objPing
      Select Case objStatus.statuscode
         Case 0: Result1 = "ONLINE"
         Case Else: Result1 = "OFFLINE"
      End Select
      GetPingResult = Result1
   Next

   Set objPing = Nothing

End Function

Sub GetIPStatus()

  Dim Cell As Range
  Dim IPRANGE As Range
  Dim Result As String
  Dim wks As Worksheet


Set wks = Worksheets("Sheet1")

Set IPRANGE = wks.Range("B3")
Set RngEnd = wks.Cells(Rows.Count, IPRANGE.Column).End(xlUp)
Set IPRANGE = IIf(RngEnd.Row < IPRANGE.Row, IPRANGE, wks.Range(IPRANGE, RngEnd))

  For Each Cell In IPRANGE
    Result = GetPingResult(Cell)
    Cell.Offset(0, 1) = Result
  Next Cell

End Sub
------------------------------------
I tried this:

Sub PingSelectedCell()

Dim Cell As String

ActiveCell.Select
Cell = GetPingResult(ActiveCell.Value)

Result = GetPingResult(Cell)
ActiveCell.Offset(0, 1) = Result

End Sub

但它只是不断离线返回我错过了什么?

2 个答案:

答案 0 :(得分:2)

Cell = GetPingResult(ActiveCell.Value)
Result = GetPingResult(Cell)

您只需要一个声明:

Result = GetPingResult(ActiveCell.Value)

然后:

ActiveCell.Offset(0, 1).Value = Result

答案 1 :(得分:0)

非常感谢你的工作!

Sub PingSelectedCell()

Dim Cell As String

Result = GetPingResult(ActiveCell.Value)
ActiveCell.Offset(0, 1).Value = Result

End Sub