Private Sub Command1_Click()   '定义、声明EXCEL对象
  Dim xlapp As Excel.Application
  Dim xlbook As Excel.Workbook
  Dim xlsheet As Excel.Worksheet  Set xlapp = New Excel.Application
  
'选定EXCEL文件路径传递
  If Right(File1.Path, 1) <> "\" Then
    FileName1 = File1.Path + "\" + File1.FileName
  Else
    FileName1 = File1.Path + File1.FileName
  End If
  
'打开需转换的EXCEL  Set xlbook = xlapp.Workbooks.Open(FileName1)
  xlapp.Visible = False'判断“实测大断面成果表”
  Dim n, c As Integer
  Dim sign As Boolean  
  If Option1(0).Value = True Then'运行第二遍时停在这个地方
’报错信息为“实时错误462:远程服务器不存在或不能使用
    If Right(Range(Cells(1, 1), Cells(1, 1)), 7) = "实测流量成果表" Then

      n = ActiveSheet.Range(Cells(65535, 1), Cells(65535, 1)).End(xlUp).Row   '计算总行数
      c = 0                                                                   '合计出错处
      For i = 6 To n
        If Val(Range(Cells(i, 1), Cells(i, 1))) <> 0 Then
      '月日检查
      
      
      '起止时:分检查
          Dim hour1, hour2, min1, min2 As Integer          hour1 = Val(Range(Cells(i, 4), Cells(i, 4)))
          hour2 = Val(Range(Cells(i, 5), Cells(i, 5)))
          min1 = Val(Right(Range(Cells(i, 4), Cells(i, 4)), 2))
          min2 = Val(Right(Range(Cells(i, 5), Cells(i, 5)), 2))
          sign = False
          If hour1 > 24 Or hour2 > 24 Then sign = True
          If min1 > 60 Or min1 > 60 Then sign = True
          
          If hour1 > 20 And hour2 < 5 Then hour2 = hour2 + 24
          If hour1 = hour2 And min1 >= min2 Then sign = True
          If hour1 > hour2 Then sign = True
          If Abs(hour2 - hour1) > 5 Then sign = True
      
          If sign = True Then
            Range(Cells(i, 4), Cells(i, 5)).Select
            Selection.Font.ColorIndex = 3
            c = c + 1
          End If
              
      
      
      '"流速"平均值与最大值检查
          Dim v1, v2 As Single
          sign = False
          v1 = Val(Range(Cells(i, 11), Cells(i, 11)))
          v2 = Val(Range(Cells(i, 12), Cells(i, 12)))
          If v1 >= v2 Then sign = True
          
          If sign = True Then
            Range(Cells(i, 11), Cells(i, 12)).Select
            Selection.Font.ColorIndex = 3
            c = c + 1
          End If
      
      
      '"水深"平均值与最大值检查
          Dim d1, d2 As Single
          sign = False
          d1 = Val(Range(Cells(i, 14), Cells(i, 14)))
          d2 = Val(Range(Cells(i, 15), Cells(i, 15)))
          If d1 >= d2 Then sign = True
          
          If sign = True Then
            Range(Cells(i, 14), Cells(i, 15)).Select
            Selection.Font.ColorIndex = 3
            c = c + 1
          End If
      
      '糙率检查
          If Range(Cells(i, 16), Cells(i, 16)) <> "" Then
            Dim s, n0 As Double
          
            sign = False
            s = Val(Range(Cells(i, 16), Cells(i, 16))) / 10000
            n0 = Round((d1 ^ (2 / 3)) * (s ^ (1 / 2)) / v1, 3)
            If n0 <> Val(Range(Cells(i, 17), Cells(i, 17))) Then sign = True
            If sign = True Then
              Range(Cells(i, 17), Cells(i, 17)).Select
              Selection.Font.ColorIndex = 3
              c = c + 1
            End If
          
          End If
      
        End If
      Next i
      If c = 0 Then
        return_value = MsgBox("未发现错误!", 48, "检查结束")
      Else
        return_value = MsgBox("发现" & c & "处错误!", 48, "检查结束")
      End If
      
    Else
      return_value = MsgBox("此表非实测流量成果表", 16, "错误")
    End If
  End If
'关闭当前EXCLE表
  xlapp.DisplayAlerts = False       '不提示保存
  xlbook.Close
  xlapp.Quit
  Set xlsheet = Nothing
  Set xlbook = Nothing
  Set xlapp = Nothing
  
Shell "taskkill /im EXCEL.exe /f", vbHide    '强行杀EXCEL.EXE进程  '============关闭对象==============
    Set xlsheet = Nothing
    'Workbook 和 Application 应该分别处理
    If Not xlbook Is Nothing Then
        xlbook.Close
        Set xlbook = Nothing
    End If
    If Not xlapp Is Nothing Then
        xlapp.Quit
        Set xlapp = Nothing
    End IfEnd Sub不知道用哪种方法,就用了各种结束EXCEL.EXE的方法,但还是不奏效。。
遂请VB高手不吝赐教,小弟在这谢谢了。

解决方案 »

  1.   

    你把excel关闭了当然服务器不存在了。
      

  2.   

    你的代码是从宏里粘出来的吗?还要做修改的。
    ActiveSheet.Range
    要修改成 xlapp.ActiveSheet.Range
    Range(Cells(i, 14), Cells(i, 15)).Select
    也要修改成xlsheet.Range(Cells(i, 14), Cells(i, 15)).Select
    类似的地方都要修改。要不然就会出现第一次正常运行,第二次运行不了的情况。
      

  3.   

      '定义、声明EXCEL对象
      Dim xlapp As Excel.Application
      Dim xlbook As Excel.Workbook
      Dim xlsheet As Excel.Worksheet你定义的这三个东西,根本就没有用到。怎么会对呢?我说的修改也不一定对,我也没试。你代码中的操作一定要对当前对象操作。
    像这个
    Range(Cells(i, 11), Cells(i, 12)).Select
    一定要对你声明的对象进行操作
    xlsheet.Range(Cells(i, 14), Cells(i, 15)).Select你就照着这个思路走。
      

  4.   

    按下command1
     Command1.Enabled = False
    执行完任务
     Command1.Enabled = True
    ------------------------------------------Private Sub Command1_Click()
     Command1.Enabled = False
      '定义、声明EXCEL对象
      Dim xlapp As Excel.Application
      Dim xlbook As Excel.Workbook
      Dim xlsheet As Excel.Worksheet  Set xlapp = New Excel.Application
      
    ' 选定EXCEL文件路径传递
      If Right(File1.Path, 1) <> "\" Then
      FileName1 = File1.Path + "\" + File1.FileName
      Else
      FileName1 = File1.Path + File1.FileName
      End If
      
    '打开需转换的 EXCEL  Set xlbook = xlapp.Workbooks.Open(FileName1)
      xlapp.Visible = False'判断“实测大断面成果表”
      Dim n, c As Integer
      Dim sign As Boolean  
      If Option1(0).Value = True Then'运行第二遍时停在这个地方
    ’报错信息为“实时错误462:远程服务器不存在或不能使用
    If Right(Range(Cells(1, 1), Cells(1, 1)), 7) = "实测流量成果表" Then
      n = ActiveSheet.Range(Cells(65535, 1), Cells(65535, 1)).End(xlUp).Row '计算总行数
      c = 0 '合计出错处
      For i = 6 To n
      If Val(Range(Cells(i, 1), Cells(i, 1))) <> 0 Then
      '月日检查
       
       
      '起止时:分检查
      Dim hour1, hour2, min1, min2 As Integer  hour1 = Val(Range(Cells(i, 4), Cells(i, 4)))
      hour2 = Val(Range(Cells(i, 5), Cells(i, 5)))
      min1 = Val(Right(Range(Cells(i, 4), Cells(i, 4)), 2))
      min2 = Val(Right(Range(Cells(i, 5), Cells(i, 5)), 2))
      sign = False
      If hour1 > 24 Or hour2 > 24 Then sign = True
      If min1 > 60 Or min1 > 60 Then sign = True
       
      If hour1 > 20 And hour2 < 5 Then hour2 = hour2 + 24
      If hour1 = hour2 And min1 >= min2 Then sign = True
      If hour1 > hour2 Then sign = True
      If Abs(hour2 - hour1) > 5 Then sign = True
       
      If sign = True Then
      Range(Cells(i, 4), Cells(i, 5)).Select
      Selection.Font.ColorIndex = 3
      c = c + 1
      End If
       
       
       
      '"流速"平均值与最大值检查
      Dim v1, v2 As Single
      sign = False
      v1 = Val(Range(Cells(i, 11), Cells(i, 11)))
      v2 = Val(Range(Cells(i, 12), Cells(i, 12)))
      If v1 >= v2 Then sign = True
       
      If sign = True Then
      Range(Cells(i, 11), Cells(i, 12)).Select
      Selection.Font.ColorIndex = 3
      c = c + 1
      End If
       
       
      '"水深"平均值与最大值检查
      Dim d1, d2 As Single
      sign = False
      d1 = Val(Range(Cells(i, 14), Cells(i, 14)))
      d2 = Val(Range(Cells(i, 15), Cells(i, 15)))
      If d1 >= d2 Then sign = True
       
      If sign = True Then
      Range(Cells(i, 14), Cells(i, 15)).Select
      Selection.Font.ColorIndex = 3
      c = c + 1
      End If
       
      '糙率检查
      If Range(Cells(i, 16), Cells(i, 16)) <> "" Then
      Dim s, n0 As Double
       
      sign = False
      s = Val(Range(Cells(i, 16), Cells(i, 16))) / 10000
      n0 = Round((d1 ^ (2 / 3)) * (s ^ (1 / 2)) / v1, 3)
      If n0 <> Val(Range(Cells(i, 17), Cells(i, 17))) Then sign = True
      If sign = True Then
      Range(Cells(i, 17), Cells(i, 17)).Select
      Selection.Font.ColorIndex = 3
      c = c + 1
      End If
       
      End If
       
      End If
      Next i
      If c = 0 Then
      return_value = MsgBox("未发现错误!", 48, "检查结束")
      Else
      return_value = MsgBox("发现" & c & "处错误!", 48, "检查结束")
      End If
       
      Else
      return_value = MsgBox("此表非实测流量成果表", 16, "错误")
      End If
      End If'关闭当前EXCLE表
      xlapp.DisplayAlerts = False '不提示保存
      xlbook.Close
      xlapp.Quit
      Set xlsheet = Nothing
      Set xlbook = Nothing
      Set xlapp = Nothing
       Command1.Enabled = True
    End Sub