7,762
社区成员
发帖
与我相关
我的任务
分享关于表格操作中的多选问题!
我想实现这样一个功能,就是在一个窗体中弹出另一个窗口,在这个弹出的窗口中有一个表格[TDBGRID或DBGRID都可以],里面包含着所有的人事资料记录,在让用户选择时能够多项选取,并把选取的多条记录返回到调用它的窗口里!请问各位高手帮助如何实现?
不解之处:如何让用户多项选择,并能把选中的这几条记录返回到调用它的窗口里!
不解之处:如何让用户多项选择,并能把选中的这几条记录返回到调用它的窗口里!
...全文
请发表友善的回复…
发表回复
pinelee 2003-06-09
- 打赏
- 举报
'fg 为vsflexgrid控件，运用以下这个方法就可以获取选中的行数。
'如何多选：可以采用鼠标拖拉，或者按住SHIFT按钮键，再运用鼠标选择即可
Dim i As Long
fg.SelectionMode = flexSelectionList
For i = 0 To fg.SelectedRows - 1
Debug.Print "Row "; fg.SelectedRow(i); " is selected"
Next i
'如何获取数据：
'可以采用ADO记录集的方式(无需Connection对象) ：
dim rs as adodb.recordset
set rs=new adodb.recordset
rs.AppendField ""
rs.AppendField ""
rs.AppendField ""
rs.open
'样你把这个rs对象传到那个人事资料窗口中，在人事资料窗口中选中后确定结束时，
'添加以下内容
if not rs is nothing then
if rs.recordcount >0 then
rs.movefirst
for i=1 to rs.recordcount
rs,delete
rs.movenext
next i
end if
'以下对选中进行循环
For i = 0 To fg.SelectedRows - 1
rs.addnew
'rs.field("").value=
'rs.field("").value=
'rs.field("").value=
Next i
end if
'希望你能看懂
pinelee 2003-06-06
- 打赏
- 举报
你不要着急，我来看看
stiffe01 2003-05-28
- 打赏
- 举报
有没有更简单一点的方法，楼上那个太麻烦了！*^_^*
MY QQ:3433590
欢迎大家一起交流！
MY QQ:3433590
欢迎大家一起交流！
qingming81 2003-05-26
- 打赏
- 举报
看错了你的要求
ecivilian 2003-05-26
- 打赏
- 举报
Option Explicit
Private mrst As ADODB.Recordset
Private mstrName As String '选定的配置单名
Private mintStat As Integer '选择还是编辑状态
Public Property Let Stat(ByVal iStat As Integer)
mintStat = iStat
End Property
Public Property Get Stat() As Integer
Stat = mintStat
End Property
Public Property Get PZName() As String
PZName = mstrName
End Property
Private Sub Form_Load()
Dim lngWidth As Long
Set mrst = New ADODB.Recordset
mrst.Open "select DISTINCT 名称,配置类型,备注 from 配置", g_conn, adOpenStatic, adLockReadOnly
Set hfgd机型.DataSource = mrst
With hfgd机型
lngWidth = .Width
.ColWidth(0) = lngWidth * 0.03
.ColWidth(1) = lngWidth * 0.25
.ColWidth(2) = lngWidth * 0.25
.ColWidth(3) = lngWidth * 0.45
End With
mstrName = ""
End Sub
'刷新网格中的数据
Public Sub Refreshfgd()
Dim lngWidth As Long
' On Error Resume Next
If mrst.State = 1 Then
mrst.Close
End If
mrst.Open "select DISTINCT 名称,配置类型,备注 from 配置", g_conn, adOpenStatic, adLockReadOnly
Set hfgd机型.DataSource = mrst
With hfgd机型
lngWidth = .Width
.ColWidth(0) = lngWidth * 0.03
.ColWidth(1) = lngWidth * 0.25
.ColWidth(2) = lngWidth * 0.25
.ColWidth(3) = lngWidth * 0.45
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
' On Error Resume Next
If mrst.State = 1 Then
mrst.Close
End If
Set mrst = Nothing
End Sub
Private Sub Form_Resize()
Dim lngWidth As Long
On Error Resume Next
With hfgd机型
.Move .Left, .Top, ScaleWidth - 2 * .Left, ScaleHeight - .Top - .Left
lngWidth = .Width
.ColWidth(0) = lngWidth * 0.03
.ColWidth(1) = lngWidth * 0.25
.ColWidth(2) = lngWidth * 0.25
.ColWidth(3) = lngWidth * 0.45
End With
End Sub
Private Sub hfgd机型_DblClick()
If mintStat <> conEdit Then
With hfgd机型
If .Row > 0 Then
mstrName = .TextMatrix(.Row, 1)
End If
End With
Me.Hide '在选择状态时选定好一个后就把这个窗体隐掉
Else
Call Edit_机型
End If
End Sub
Private Sub tbl机型_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "增加"
frm配置录入.Show vbModal
Call Refreshfgd
Case "删除"
Call Delete_机型
Case "修改"
Call Edit_机型
Case "打印"
Call Print_机型
Case "返回"
Unload Me
End Select
End Sub
Private Sub Delete_机型()
Dim lResp As Long
Dim strSql As String
lResp = vbNo
If hfgd机型.Row > 0 Then '有选定的行
lResp = MsgBox("确实要删除此机型？", vbYesNo + vbDefaultButton2 + vbQuestion)
If lResp = vbNo Then
Exit Sub
End If
strSql = "delete * from 配置 where 名称 = '" & hfgd机型.TextMatrix(hfgd机型.Row, 1) & "'"
g_conn.Execute strSql
Call Refreshfgd
End If
End Sub
Private Sub Edit_机型()
If hfgd机型.Row > 0 Then '有选定的行
frm配置录入.strStyle = hfgd机型.TextMatrix(hfgd机型.Row, 1)
frm配置录入.Show vbModal
End If
Call Refreshfgd
End Sub
Private Sub Print_机型()
Dim str As String
Dim rst As ADODB.Recordset
Dim rsttemp As ADODB.Recordset
Set rst = New ADODB.Recordset
Set rsttemp = New ADODB.Recordset
If hfgd机型.Row > 0 Then
str = "select A.*,B.名称 as 配件名称 from 配置 A,配件 B where A.配件代码 = B.代码 and A.名称 = '" & hfgd机型.TextMatrix(hfgd机型.Row, 1) & "'"
rst.Open str, g_conn, adOpenDynamic, adLockReadOnly
g_conn.Execute ("delete * from temp")
rsttemp.Open "temp", g_conn, adOpenDynamic, adLockOptimistic
With rst
If .RecordCount <> 0 Then
.MoveFirst
Do Until .EOF
rsttemp.AddNew
rsttemp!A = !名称
rsttemp!b = !备注
rsttemp!c = !配件代码
rsttemp!d = !配件名称
rsttemp!e = get_path(!配件代码)
rsttemp!f = !数量
rsttemp.Update
.MoveNext
Loop
End If
End With
rsttemp.Close
rst.Close
frmPrinting.Show vbModal
rpt机型.Show vbModal
End If
Set rsttemp = Nothing
Set rst = Nothing
End Sub
注意上面两个窗体中的vfgDetail_DblClick()，就是在这儿实现的。
Private mrst As ADODB.Recordset
Private mstrName As String '选定的配置单名
Private mintStat As Integer '选择还是编辑状态
Public Property Let Stat(ByVal iStat As Integer)
mintStat = iStat
End Property
Public Property Get Stat() As Integer
Stat = mintStat
End Property
Public Property Get PZName() As String
PZName = mstrName
End Property
Private Sub Form_Load()
Dim lngWidth As Long
Set mrst = New ADODB.Recordset
mrst.Open "select DISTINCT 名称,配置类型,备注 from 配置", g_conn, adOpenStatic, adLockReadOnly
Set hfgd机型.DataSource = mrst
With hfgd机型
lngWidth = .Width
.ColWidth(0) = lngWidth * 0.03
.ColWidth(1) = lngWidth * 0.25
.ColWidth(2) = lngWidth * 0.25
.ColWidth(3) = lngWidth * 0.45
End With
mstrName = ""
End Sub
'刷新网格中的数据
Public Sub Refreshfgd()
Dim lngWidth As Long
' On Error Resume Next
If mrst.State = 1 Then
mrst.Close
End If
mrst.Open "select DISTINCT 名称,配置类型,备注 from 配置", g_conn, adOpenStatic, adLockReadOnly
Set hfgd机型.DataSource = mrst
With hfgd机型
lngWidth = .Width
.ColWidth(0) = lngWidth * 0.03
.ColWidth(1) = lngWidth * 0.25
.ColWidth(2) = lngWidth * 0.25
.ColWidth(3) = lngWidth * 0.45
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
' On Error Resume Next
If mrst.State = 1 Then
mrst.Close
End If
Set mrst = Nothing
End Sub
Private Sub Form_Resize()
Dim lngWidth As Long
On Error Resume Next
With hfgd机型
.Move .Left, .Top, ScaleWidth - 2 * .Left, ScaleHeight - .Top - .Left
lngWidth = .Width
.ColWidth(0) = lngWidth * 0.03
.ColWidth(1) = lngWidth * 0.25
.ColWidth(2) = lngWidth * 0.25
.ColWidth(3) = lngWidth * 0.45
End With
End Sub
Private Sub hfgd机型_DblClick()
If mintStat <> conEdit Then
With hfgd机型
If .Row > 0 Then
mstrName = .TextMatrix(.Row, 1)
End If
End With
Me.Hide '在选择状态时选定好一个后就把这个窗体隐掉
Else
Call Edit_机型
End If
End Sub
Private Sub tbl机型_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "增加"
frm配置录入.Show vbModal
Call Refreshfgd
Case "删除"
Call Delete_机型
Case "修改"
Call Edit_机型
Case "打印"
Call Print_机型
Case "返回"
Unload Me
End Select
End Sub
Private Sub Delete_机型()
Dim lResp As Long
Dim strSql As String
lResp = vbNo
If hfgd机型.Row > 0 Then '有选定的行
lResp = MsgBox("确实要删除此机型？", vbYesNo + vbDefaultButton2 + vbQuestion)
If lResp = vbNo Then
Exit Sub
End If
strSql = "delete * from 配置 where 名称 = '" & hfgd机型.TextMatrix(hfgd机型.Row, 1) & "'"
g_conn.Execute strSql
Call Refreshfgd
End If
End Sub
Private Sub Edit_机型()
If hfgd机型.Row > 0 Then '有选定的行
frm配置录入.strStyle = hfgd机型.TextMatrix(hfgd机型.Row, 1)
frm配置录入.Show vbModal
End If
Call Refreshfgd
End Sub
Private Sub Print_机型()
Dim str As String
Dim rst As ADODB.Recordset
Dim rsttemp As ADODB.Recordset
Set rst = New ADODB.Recordset
Set rsttemp = New ADODB.Recordset
If hfgd机型.Row > 0 Then
str = "select A.*,B.名称 as 配件名称 from 配置 A,配件 B where A.配件代码 = B.代码 and A.名称 = '" & hfgd机型.TextMatrix(hfgd机型.Row, 1) & "'"
rst.Open str, g_conn, adOpenDynamic, adLockReadOnly
g_conn.Execute ("delete * from temp")
rsttemp.Open "temp", g_conn, adOpenDynamic, adLockOptimistic
With rst
If .RecordCount <> 0 Then
.MoveFirst
Do Until .EOF
rsttemp.AddNew
rsttemp!A = !名称
rsttemp!b = !备注
rsttemp!c = !配件代码
rsttemp!d = !配件名称
rsttemp!e = get_path(!配件代码)
rsttemp!f = !数量
rsttemp.Update
.MoveNext
Loop
End If
End With
rsttemp.Close
rst.Close
frmPrinting.Show vbModal
rpt机型.Show vbModal
End If
Set rsttemp = Nothing
Set rst = Nothing
End Sub
注意上面两个窗体中的vfgDetail_DblClick()，就是在这儿实现的。
ecivilian 2003-05-26
- 打赏
- 举报
Option Explicit
'保存一组窗体变量数组，其数量与名称相互对应。
Private PName() As String '配件名称
Private PSum() As Integer '该配件已选定的数量
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Call RemoveNullRow
Me.Hide
End Sub
Private Sub Form_Load()
ReDim PName(0)
ReDim PSum(0)
End Sub
Private Sub tbrTool_ButtonClick(ByVal Button As MSComctlLib.Button)
' On Error Resume Next
Select Case Button.Key
Case "增加"
vfgDetail.AddItem ""
Case "删除"
With vfgDetail
If .Row > 0 Then
If .TextMatrix(.Row, 1) <> "" And Val(.TextMatrix(.Row, 2)) > 0 Then
Call EraseArray(.TextMatrix(.Row, 1), Val(.TextMatrix(.Row, 2))) '在当前数据中去除相应的数量
End If
.RemoveItem .Row
End If
End With
End Select
End Sub
Private Sub vfgDetail_AfterEdit(ByVal Row As Long, ByVal Col As Long)
Select Case Col
Case 1
If vfgDetail.TextMatrix(Row, Col) = "" Then
MsgBox "配件代码不能为空！", vbExclamation
Else
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.Open "select * from 配置 where 名称 = '" & vfgDetail.TextMatrix(Row, Col) & "'", g_conn, adOpenDynamic, adLockReadOnly
With rst
If .EOF Or .BOF Then
MsgBox "输入的机器配置代码没找到，请重新输入！", vbExclamation, "提示"
vfgDetail.TextMatrix(Row, Col) = ""
End If
End With
rst.Close
Set rst = Nothing
End If
'将后面的数量清0,以防先填数量后填名称
vfgDetail.TextMatrix(Row, 2) = ""
Case 2
If Val(vfgDetail.TextMatrix(Row, Col)) < 1 Then
MsgBox "配件数量不能小于1！", vbExclamation
vfgDetail.TextMatrix(Row, Col) = ""
Else
If CheckSum(vfgDetail.TextMatrix(Row, 1), Val(vfgDetail.TextMatrix(Row, 2))) = False Then
MsgBox "选定的配件数量已经超出库存中的数量，请重新输入！", vbExclamation, "提示"
vfgDetail.TextMatrix(Row, Col) = ""
End If
End If
If Row = vfgDetail.Rows - 1 Then
vfgDetail.AddItem ""
End If
End Select
End Sub
'去除vfgDetail中的空行
Public Sub RemoveNullRow()
Dim i As Integer
Dim i2 As Integer
With vfgDetail
If .Rows < 2 Then
Exit Sub
End If
i2 = 1
For i = 1 To .Rows - 1
If .TextMatrix(i2, 1) = "" Then
.RemoveItem i2
i2 = i2 - 1
End If
i2 = i2 + 1
Next
End With
End Sub
'检查指定的配置单和份数在累计配件数量后是否有配件超过库存中的数量，如超过则返回False
Private Function CheckSum(ByVal strName As String, ByVal iCopies As Integer) As Boolean
Dim rst As ADODB.Recordset
Dim sArray() As String
Dim iArray() As Integer
Dim sSql As String
Dim i As Integer
Dim i2 As Integer
Dim itemp As Integer
Dim bPass As Boolean
Dim iSum As Integer
iSum = 0
i = 1
Set rst = New ADODB.Recordset
sSql = "select * from 配置 where 名称 ='" & strName & "'"
rst.Open sSql, g_conn, adOpenStatic, adLockReadOnly
With rst
If .RecordCount > 0 Then
.MoveFirst
'将配件读入数组
Do Until .EOF
ReDim Preserve sArray(i)
ReDim Preserve iArray(i)
sArray(i) = !配件代码
iArray(i) = !数量 * iCopies
.MoveNext
i = i + 1
Loop
End If
End With
rst.Close
Set rst = Nothing
'检查是否有数量超出
For i = 1 To UBound(sArray)
itemp = iArray(i)
For i2 = 1 To UBound(PName)
If sArray(i) = PName(i2) Then
itemp = itemp + PSum(i2)
Exit For
End If
Next i2
bPass = CheckAmount(sArray(i), itemp)
If bPass = False Then
Exit For
End If
Next i
If bPass = True Then '全部配件在库中都有
'归入当前总数
For i = 1 To UBound(sArray)
For i2 = 1 To UBound(PName)
If sArray(i) = PName(i2) Then '相同则累加
PSum(i2) = PSum(i2) + iArray(i)
Exit For
End If
Next i2
'因为上面有Exit For，所以i2在找到时不会超过ubound(PName),超过的话肯定是没找到。
If i2 > UBound(PName) Then
ReDim Preserve PName(UBound(PName) + 1)
ReDim Preserve PSum(UBound(PSum) + 1)
PName(UBound(PName)) = sArray(i)
PSum(UBound(PSum)) = iArray(i)
End If
Next i
End If
CheckSum = bPass
End Function
'在当前数据中去除相应的数量
Private Sub EraseArray(ByVal strName As String, ByVal iCopies As Integer)
Dim rst As ADODB.Recordset
Dim sArray() As String
Dim iArray() As Integer
Dim sSql As String
Dim i As Integer
Dim i2 As Integer
Dim itemp As Integer
i = 1
Set rst = New ADODB.Recordset
sSql = "select * from 配置 where 名称 ='" & strName & "'"
rst.Open sSql, g_conn, adOpenStatic, adLockReadOnly
With rst
If .RecordCount > 0 Then
.MoveFirst
'将配件读入数组
Do Until .EOF
ReDim Preserve sArray(i)
ReDim Preserve iArray(i)
sArray(i) = !配件代码
iArray(i) = !数量 * iCopies
.MoveNext
i = i + 1
Loop
End If
End With
rst.Close
Set rst = Nothing
'在当前数据中去除
For i = 1 To UBound(sArray)
For i2 = 1 To UBound(PName)
If sArray(i) = PName(i2) Then '相同则去除
PSum(i2) = PSum(i2) - iArray(i)
Exit For
End If
Next i2
'如果没找到，则也没必要做什么
Next i
End Sub
'检查指定的配件代码在库存中的数量，如库存量小于输入值iAmount则返回False
Private Function CheckAmount(ByVal strCode As String, ByVal iAmount As Integer) As Boolean
Dim rst As ADODB.Recordset
Dim iSum As Integer
Dim sSql As String
iSum = 0
Set rst = New ADODB.Recordset
sSql = "select * from 库存 where 代码 ='" & strCode & "'"
rst.Open sSql, g_conn, adOpenStatic, adLockReadOnly
With rst
If .RecordCount > 0 Then
.MoveFirst
Do Until .EOF
iSum = iSum + !数量
.MoveNext
Loop
End If
End With
rst.Close
Set rst = Nothing
If iSum < iAmount Then
CheckAmount = False
Else
CheckAmount = True
End If
End Function
Private Sub vfgDetail_DblClick()
With vfgDetail
If .Col = 1 Then '显示选择窗体
frm机型配置.Stat = conChoose
frm机型配置.Show vbModal
If Not frm机型配置 Is Nothing Then
If frm机型配置.PZName <> "" Then
.TextMatrix(.Row, 1) = frm机型配置.PZName
End If
End If
End If
End With
End Sub
这个窗体和frm机型配置都可以被别的窗体引用。
'保存一组窗体变量数组，其数量与名称相互对应。
Private PName() As String '配件名称
Private PSum() As Integer '该配件已选定的数量
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Call RemoveNullRow
Me.Hide
End Sub
Private Sub Form_Load()
ReDim PName(0)
ReDim PSum(0)
End Sub
Private Sub tbrTool_ButtonClick(ByVal Button As MSComctlLib.Button)
' On Error Resume Next
Select Case Button.Key
Case "增加"
vfgDetail.AddItem ""
Case "删除"
With vfgDetail
If .Row > 0 Then
If .TextMatrix(.Row, 1) <> "" And Val(.TextMatrix(.Row, 2)) > 0 Then
Call EraseArray(.TextMatrix(.Row, 1), Val(.TextMatrix(.Row, 2))) '在当前数据中去除相应的数量
End If
.RemoveItem .Row
End If
End With
End Select
End Sub
Private Sub vfgDetail_AfterEdit(ByVal Row As Long, ByVal Col As Long)
Select Case Col
Case 1
If vfgDetail.TextMatrix(Row, Col) = "" Then
MsgBox "配件代码不能为空！", vbExclamation
Else
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.Open "select * from 配置 where 名称 = '" & vfgDetail.TextMatrix(Row, Col) & "'", g_conn, adOpenDynamic, adLockReadOnly
With rst
If .EOF Or .BOF Then
MsgBox "输入的机器配置代码没找到，请重新输入！", vbExclamation, "提示"
vfgDetail.TextMatrix(Row, Col) = ""
End If
End With
rst.Close
Set rst = Nothing
End If
'将后面的数量清0,以防先填数量后填名称
vfgDetail.TextMatrix(Row, 2) = ""
Case 2
If Val(vfgDetail.TextMatrix(Row, Col)) < 1 Then
MsgBox "配件数量不能小于1！", vbExclamation
vfgDetail.TextMatrix(Row, Col) = ""
Else
If CheckSum(vfgDetail.TextMatrix(Row, 1), Val(vfgDetail.TextMatrix(Row, 2))) = False Then
MsgBox "选定的配件数量已经超出库存中的数量，请重新输入！", vbExclamation, "提示"
vfgDetail.TextMatrix(Row, Col) = ""
End If
End If
If Row = vfgDetail.Rows - 1 Then
vfgDetail.AddItem ""
End If
End Select
End Sub
'去除vfgDetail中的空行
Public Sub RemoveNullRow()
Dim i As Integer
Dim i2 As Integer
With vfgDetail
If .Rows < 2 Then
Exit Sub
End If
i2 = 1
For i = 1 To .Rows - 1
If .TextMatrix(i2, 1) = "" Then
.RemoveItem i2
i2 = i2 - 1
End If
i2 = i2 + 1
Next
End With
End Sub
'检查指定的配置单和份数在累计配件数量后是否有配件超过库存中的数量，如超过则返回False
Private Function CheckSum(ByVal strName As String, ByVal iCopies As Integer) As Boolean
Dim rst As ADODB.Recordset
Dim sArray() As String
Dim iArray() As Integer
Dim sSql As String
Dim i As Integer
Dim i2 As Integer
Dim itemp As Integer
Dim bPass As Boolean
Dim iSum As Integer
iSum = 0
i = 1
Set rst = New ADODB.Recordset
sSql = "select * from 配置 where 名称 ='" & strName & "'"
rst.Open sSql, g_conn, adOpenStatic, adLockReadOnly
With rst
If .RecordCount > 0 Then
.MoveFirst
'将配件读入数组
Do Until .EOF
ReDim Preserve sArray(i)
ReDim Preserve iArray(i)
sArray(i) = !配件代码
iArray(i) = !数量 * iCopies
.MoveNext
i = i + 1
Loop
End If
End With
rst.Close
Set rst = Nothing
'检查是否有数量超出
For i = 1 To UBound(sArray)
itemp = iArray(i)
For i2 = 1 To UBound(PName)
If sArray(i) = PName(i2) Then
itemp = itemp + PSum(i2)
Exit For
End If
Next i2
bPass = CheckAmount(sArray(i), itemp)
If bPass = False Then
Exit For
End If
Next i
If bPass = True Then '全部配件在库中都有
'归入当前总数
For i = 1 To UBound(sArray)
For i2 = 1 To UBound(PName)
If sArray(i) = PName(i2) Then '相同则累加
PSum(i2) = PSum(i2) + iArray(i)
Exit For
End If
Next i2
'因为上面有Exit For，所以i2在找到时不会超过ubound(PName),超过的话肯定是没找到。
If i2 > UBound(PName) Then
ReDim Preserve PName(UBound(PName) + 1)
ReDim Preserve PSum(UBound(PSum) + 1)
PName(UBound(PName)) = sArray(i)
PSum(UBound(PSum)) = iArray(i)
End If
Next i
End If
CheckSum = bPass
End Function
'在当前数据中去除相应的数量
Private Sub EraseArray(ByVal strName As String, ByVal iCopies As Integer)
Dim rst As ADODB.Recordset
Dim sArray() As String
Dim iArray() As Integer
Dim sSql As String
Dim i As Integer
Dim i2 As Integer
Dim itemp As Integer
i = 1
Set rst = New ADODB.Recordset
sSql = "select * from 配置 where 名称 ='" & strName & "'"
rst.Open sSql, g_conn, adOpenStatic, adLockReadOnly
With rst
If .RecordCount > 0 Then
.MoveFirst
'将配件读入数组
Do Until .EOF
ReDim Preserve sArray(i)
ReDim Preserve iArray(i)
sArray(i) = !配件代码
iArray(i) = !数量 * iCopies
.MoveNext
i = i + 1
Loop
End If
End With
rst.Close
Set rst = Nothing
'在当前数据中去除
For i = 1 To UBound(sArray)
For i2 = 1 To UBound(PName)
If sArray(i) = PName(i2) Then '相同则去除
PSum(i2) = PSum(i2) - iArray(i)
Exit For
End If
Next i2
'如果没找到，则也没必要做什么
Next i
End Sub
'检查指定的配件代码在库存中的数量，如库存量小于输入值iAmount则返回False
Private Function CheckAmount(ByVal strCode As String, ByVal iAmount As Integer) As Boolean
Dim rst As ADODB.Recordset
Dim iSum As Integer
Dim sSql As String
iSum = 0
Set rst = New ADODB.Recordset
sSql = "select * from 库存 where 代码 ='" & strCode & "'"
rst.Open sSql, g_conn, adOpenStatic, adLockReadOnly
With rst
If .RecordCount > 0 Then
.MoveFirst
Do Until .EOF
iSum = iSum + !数量
.MoveNext
Loop
End If
End With
rst.Close
Set rst = Nothing
If iSum < iAmount Then
CheckAmount = False
Else
CheckAmount = True
End If
End Function
Private Sub vfgDetail_DblClick()
With vfgDetail
If .Col = 1 Then '显示选择窗体
frm机型配置.Stat = conChoose
frm机型配置.Show vbModal
If Not frm机型配置 Is Nothing Then
If frm机型配置.PZName <> "" Then
.TextMatrix(.Row, 1) = frm机型配置.PZName
End If
End If
End If
End With
End Sub
这个窗体和frm机型配置都可以被别的窗体引用。
stiffe01 2003-05-26
- 打赏
- 举报
TO：qingming81(晴明)
谢谢你的帮助，但你的方法我看了，只能返回一条记录值，而我是要返回好几条记录的值到上一表单处！你再详细看一下我的问题，帮我解决一下吧，谢了！
谢谢你的帮助，但你的方法我看了，只能返回一条记录值，而我是要返回好几条记录的值到上一表单处！你再详细看一下我的问题，帮我解决一下吧，谢了！
qingming81 2003-05-26
- 打赏
- 举报
上面最后加一句:end if
qingming81 2003-05-26
- 打赏
- 举报
这个东西很简单的：只是需要定义模块变量(全局变量)，任何表格都能实现。下面是本人昨天写的一段代码：
'模块级变量
dim rs as ADODB.Recordset
dim A1
dim A2
dim A3
---
dim An
set rs = New ADODB.Recordset
----
set datagrig1.recordsource =rs '我用的是datagrid控件
'在表格控件的_Keypress事件中写(在这个地方，根本就不用多选，你只须让datagrid1获得焦点就可以取出它的全部行值)
if keyascii=13 then '让用户敲入回车即选定所有值
with rs
A1=.fields("A1")
A2=.fields("A2")
A3=.fields("A3")
-----
An=.fields("An")
end with
Form2.visible=false
Form1.show '返回控制窗口。由于A1、A2、---An都是全局变量，直接取他的值来显示就知道了
form1.text1.text=A1
form1.text2.text=A2
-----
for1.textn.text=An
'模块级变量
dim rs as ADODB.Recordset
dim A1
dim A2
dim A3
---
dim An
set rs = New ADODB.Recordset
----
set datagrig1.recordsource =rs '我用的是datagrid控件
'在表格控件的_Keypress事件中写(在这个地方，根本就不用多选，你只须让datagrid1获得焦点就可以取出它的全部行值)
if keyascii=13 then '让用户敲入回车即选定所有值
with rs
A1=.fields("A1")
A2=.fields("A2")
A3=.fields("A3")
-----
An=.fields("An")
end with
Form2.visible=false
Form1.show '返回控制窗口。由于A1、A2、---An都是全局变量，直接取他的值来显示就知道了
form1.text1.text=A1
form1.text2.text=A2
-----
for1.textn.text=An
stiffe01 2003-05-26
- 打赏
- 举报
谢谢楼上的，能不能给出段代码啊？
icedot 2003-05-24
- 打赏
- 举报
记下选中的记录的一个唯一值，如ID呀。
northwolves 2003-05-24
- 打赏
- 举报
可以用LISTVIEW的INDEX 通过遍利实现
stiffe01 2003-05-24
- 打赏
- 举报
还是没人帮我吗?
czwwh 2003-05-23
- 打赏
- 举报
用VsFlexGrid可以实现
stiffe01 2003-05-23
- 打赏
- 举报
我是想知道应该如何实现？因为这个功能应该很多表格控件都可以实现的！
