我是怕各位没有耐心看,代码如下:想法:通过mousermove和mousedown事件实现在各个ListBox框中的拖动,其中lstCls1,lstCls2.....lstCls6为相同的listbox,其间可以相互拖动,lstAdd列出了全国各个省份,只可以添加到前边的lstCls1,lstCls2,lstCls3.....。  如果lstAdd中的内容拖动到其他的列表框,则检查在除省份列表框以外的所有框是否存在正在拖动的文本。现在的问题是,当我检查出存在这样一个省份以后,我需要退出程序,有时候可以退出,有时候却总在循环提示"此省份已存在,无法添加!!", 
 请教各位大虾!Dim strMove As String
Dim i
Dim j
Dim obSource As Object
Dim strSource As String
Dim strGC2 As String
Dim strPZ2 As StringPrivate Sub cmdExit_Click()
 Me.Hide
 Set rsLst1 = Nothing
 Set rsLst2 = Nothing
 Set rsLst3 = Nothing
 Set rsLst4 = Nothing
 Set rsLst5 = Nothing
 Set rsLst6 = Nothing
' Set rsLst1 = Nothing
 lstCls1.Clear
 lstCls2.Clear
 lstCls3.Clear
 lstCls4.Clear
 lstCls5.Clear
 lstCls6.Clear
 lstAdd.Clear
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then Exit Sub
    
'    lstCls1.BackColor = vbWhite '改变颜色
    
    MousePointer = 0
    strMove = ""
    
End SubPrivate Sub lstCls1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   i = 1     '赋值i为1
   
    If lstCls1 = "" Then
        Exit Sub
        
    Else
        If Button = 1 Then
            j = lstCls1.ListIndex
            strMove = lstCls1.List(j)
            MousePointer = 2
        End If
    End If
End SubPrivate Sub lstcls1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If strMove = "" Then Exit Sub
   
   If i <> 1 Then
    '
        '如果是添加省份,那么先检查是否存在此省份
        If i = 8 Then
           Dim k As Boolean
           k = IfExist()
           
           If k = True Then
             MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
             MsgBox "请重新选择!", vbCritical + vbOKOnly, "错误"
             Exit Sub
           End If
        End If
        
        
'        If strMove = "" Then Exit Sub
        
        strGC2 = Trim(frmModData.cmbGC2.Text)
        strPZ2 = Trim(frmModData.cmbPZ2.Text)
        
        lstCls1.AddItem strMove
        rsLst1.AddNew
        rsLst1!钢厂 = strGC2
        rsLst1!省份 = strMove
        rsLst1!品种 = strPZ2
        rsLst1!区域 = "一类"
        
        rsLst1!用户名 = strUser
        rsLst1!修改时间 = Now()
        
        rsLst1.Update
        
        Call RemoveItem
        
        strMove = ""
        If Button = 0 Then MousePointer = 0
   
   End If
End Sub
Private Sub lstCls2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    i = 2     '赋值i为1
 
    If lstCls2 = "" Then
         Exit Sub
    Else
            If Button = 1 Then
                j = lstCls2.ListIndex
                strMove = lstCls2.List(j)
                MousePointer = 2
            End If
    End If
End Sub
Private Sub lstcls2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If strMove = "" Then Exit Sub
   
   If i <> 2 Then
        
        '如果是添加省份,那么先检查是否存在此省份
        If i = 8 Then
           Dim k As Boolean
           k = IfExist()
           
           If k = True Then
             MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
             MsgBox "请重新选择!", vbCritical + vbOKOnly, "错误"
             Exit Sub
           End If
        End If
     
        
        
        
        strGC2 = frmModData.cmbGC2.Text
        
        lstCls2.AddItem strMove
        
        rsLst2.AddNew
        rsLst2!钢厂 = strGC2
        rsLst2!品种 = strPZ2
        rsLst2!省份 = strMove
        rsLst2!区域 = "二类"
        
        rsLst2!用户名 = strUser
        rsLst2!修改时间 = Now()
        
        rsLst2.Update
        
        Call RemoveItem
        
        strMove = ""
        If Button = 0 Then MousePointer = 0
   End If
End SubSub RemoveItem()    If i = 1 Then
         lstCls1.RemoveItem j
         rsLst1.AbsolutePosition = j + 1
         rsLst1.Delete
         rsLst1.Update
    End If
    
    If i = 2 Then
         lstCls2.RemoveItem j
         rsLst2.AbsolutePosition = j + 1
         rsLst2.Delete
         rsLst2.Update
    End If
    If i = 3 Then
         lstCls3.RemoveItem j
         rsLst3.AbsolutePosition = j + 1
         rsLst3.Delete
         
    End If
    If i = 4 Then
         lstCls4.RemoveItem j
         rsLst4.AbsolutePosition = j + 1
         rsLst4.Delete
         
    End If
    If i = 5 Then
         lstCls5.RemoveItem j
         
         rsLst5.AbsolutePosition = j + 1
         rsLst5.Delete
    End If
    If i = 6 Then
         lstCls6.RemoveItem j
         rsLst6.AbsolutePosition = j + 1
         rsLst6.Delete
         
    End If
    If i = 7 Then
         lstCls7.RemoveItem j
         rsLst7.AbsolutePosition = j + 1
         rsLst7.Delete
    End If
    
End SubPrivate Sub lstCls3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    i = 3     '赋值i为1
 
    If lstCls3 = "" Then
     Exit Sub
    Else
            If Button = 1 Then
                j = lstCls3.ListIndex
                strMove = lstCls3.List(j)
                MousePointer = 2
            End If
    End If
End Sub
Private Sub lstcls3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If strMove = "" Then Exit Sub   If i <> 3 Then
        
        '如果是添加省份,那么先检查是否存在此省份
        If i = 8 Then
           Dim k As Boolean
           k = IfExist()
           
           If k = True Then
             MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
             MsgBox "请重新选择!", vbCritical + vbOKOnly, "错误"
             Exit Sub
           End If
        End If
        
        
        lstCls3.AddItem strMove
        strGC2 = frmModData.cmbGC2.Text
        
        rsLst3.AddNew
        rsLst3!钢厂 = strGC2
        rsLst3!品种 = strPZ2
        rsLst3!省份 = strMove
        rsLst3!区域 = "三类"
        
        rsLst3!用户名 = strUser
        rsLst3!修改时间 = Now()
        
        rsLst3.Update
        
        Call RemoveItem
        
        strMove = ""
        If Button = 0 Then MousePointer = 0
   End If
End SubPrivate Sub lstCls4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    i = 4     '赋值i为1
 
    If lstCls4 = "" Then
     Exit Sub
    Else
            If Button = 1 Then
                j = lstCls4.ListIndex
                strMove = lstCls4.List(j)
                MousePointer = 2
            End If
    End If
End Sub
Private Sub lstcls4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If strMove = "" Then Exit Sub
   
   If i <> 4 Then
        
        '如果是添加省份,那么先检查是否存在此省份
        If i = 8 Then
           Dim k As Boolean
           k = IfExist()
           
           If k = True Then
             MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
             
             MsgBox "请重新选择!", vbCritical + vbOKOnly, "错误"
             
             Exit Sub           End If
        End If
        
        lstCls4.AddItem strMove
        
        strGC2 = frmModData.cmbGC2.Text
        
        rsLst4.AddNew
        rsLst4!钢厂 = strGC2
        rsLst4!品种 = strPZ2
        rsLst4!省份 = strMove
        rsLst4!区域 = "四类"
        
        rsLst4!用户名 = strUser
        rsLst4!修改时间 = Now()
        
        rsLst4.Update
        
        Call RemoveItem
        
        strMove = ""
        If Button = 0 Then MousePointer = 0
   End If
End Sub
Private Sub lstCls5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    i = 5     '赋值i为1
 
    If lstCls5 = "" Then
     Exit Sub
    Else
            If Button = 1 Then
                j = lstCls5.ListIndex
                strMove = lstCls5.List(j)
                MousePointer = 2
            End If
    End If
End Sub
Private Sub lstcls5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
   If strMove = "" Then Exit Sub
   
   If i <> 5 Then
        
        '如果是添加省份,那么先检查是否存在此省份
        If i = 8 Then
           Dim k As Boolean
           k = IfExist()
           
           If k = True Then
             MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
             MsgBox "请重新选择!", vbCritical + vbOKOnly, "错误"
             Exit Sub
           End If
        End If
        
        
        
        
        lstCls5.AddItem strMove
        
        strGC2 = frmModData.cmbGC2.Text
        
        rsLst5.AddNew
        rsLst5!钢厂 = strGC2
        rsLst5!品种 = strPZ2
        rsLst5!省份 = strMove
        rsLst5!区域 = "五类"
        
        rsLst5!用户名 = strUser
        rsLst5!修改时间 = Now()
        
        rsLst5.Update
        
        Call RemoveItem
        
        strMove = ""
        If Button = 0 Then MousePointer = 0
   End If
End SubPrivate Sub lstCls6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    i = 6    '赋值i为1
 
    If lstCls6 = "" Then
     Exit Sub
    Else
            If Button = 1 Then
                j = lstCls6.ListIndex
                strMove = lstCls6.List(j)
                MousePointer = 2
            End If
    End If
End Sub
Private Sub lstcls6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If strMove = "" Then Exit Sub
   
   If i <> 6 Then
        '如果是添加省份,那么先检查是否存在此省份
        If i = 8 Then
           Dim k As Boolean
           k = IfExist()
           
           If k = True Then
             MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
             MsgBox "请重新选择!", vbCritical + vbOKOnly, "错误"
             Exit Sub
           End If
        End If
        
        
        
        lstCls6.AddItem strMove
        
        strGC2 = frmModData.cmbGC2.Text
        
        rsLst6.AddNew
        rsLst6!钢厂 = strGC2
        rsLst6!品种 = strPZ2
        rsLst6!省份 = strMove
        rsLst6!区域 = "六类"        rsLst6!用户名 = strUser
        rsLst6!修改时间 = Now()
        
        rsLst6.Update
        
        Call RemoveItem
        
        strMove = ""
        If Button = 0 Then MousePointer = 0
   End If
End SubPrivate Sub lstAdd_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    i = 8
    
    If lstAdd = "" Then
        Exit Sub
        
    Else
        If Button = 1 Then
            j = lstAdd.ListIndex
            strMove = lstAdd.List(j)
            MousePointer = 2
        End If
    End IfEnd Sub
Function IfExist()
  Dim cn As New ADODB.Connection
  Dim strGC As String
  cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\SB\D盘\价格查询\PriceQuery.mdb;Persist Security Info=False"
  
  strPZ2 = Trim(frmModData.cmbPZ2.Text)
  strGC2 = Trim(frmModData.cmbGC2.Text)  '取得钢厂名称
  
  Dim rs As New ADODB.Recordset
  
  rs.Open "select * from 区域省份对照表 where 钢厂='" & strGC2 & "' and 省份='" & Trim(strMove) & "' and 品种='" & strPZ2 & "'", cn, adOpenForwardOnly
  
  If rs.EOF Then
     IfExist = False
  Else
'    MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
     IfExist = True
  End If  cn.Close
End Function

解决方案 »

  1.   

    在 MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
    这句上加个断点,然后单步运行查咯
      

  2.   

    If k = True Then
                MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
                MsgBox "请重新选择!", vbCritical + vbOKOnly, "错误"
                 strMove = ""  '********控制条件
                Exit Sub
              End If
            End If
      

  3.   

    在 MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
    这句上加个断点,
    运行到以后,看看 堆栈李运行了那些过程,然后单步执行看看!
      

  4.   

          If k = True Then
                MsgBox "此省份已存在,无法添加!!请重新选择!", vbCritical + vbOKOnly, "错误"
                Exit Sub
    没必要两次谈出对话框吧          
      

  5.   

    呵呵,这还用看么?把事件写在MouseMove中,当你去点第一个Msgbox是,会接着触发MouseMove,又出现第二个Msgbox,就如此循环了!
      

  6.   

     to ArQ(阿丘)
    If strMove = "" Then Exit Sub大概是你的控制条件吧
    所有的exit sub以前都要令strMove = "" 
      

  7.   

    To uguess(uguess)即使我的鼠标不动,仅用回车键,结果也是一样!
      

  8.   

    To wjying(葡萄)你的方法很有效,谢谢!  加35分!To ferrytang(ferry)很高兴您总是能够及时回答别人的问题,谢谢! 加15分!