我是怕各位没有耐心看,代码如下:想法:通过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
请教各位大虾!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
这句上加个断点,然后单步运行查咯
MsgBox "此省份已存在,无法添加!!", vbCritical + vbOKOnly, "错误"
MsgBox "请重新选择!", vbCritical + vbOKOnly, "错误"
strMove = "" '********控制条件
Exit Sub
End If
End If
这句上加个断点,
运行到以后,看看 堆栈李运行了那些过程,然后单步执行看看!
MsgBox "此省份已存在,无法添加!!请重新选择!", vbCritical + vbOKOnly, "错误"
Exit Sub
没必要两次谈出对话框吧
If strMove = "" Then Exit Sub大概是你的控制条件吧
所有的exit sub以前都要令strMove = ""