我用MSFlexGrid1建立一个‘查询’窗体，我想当鼠标双击用户选定的记录项时，程序根据用户‘双击记录’所处在第几行，而找到数据库中‘相应得记录号’的数据信息，并通过另一个窗体弹出一个与此数据相对应的详细记录的窗体。
问题：我如何得到'鼠标双击'MSFlexGrid1控件所得到的第几行。
附：MSFlexGrid1控件中，如何设置每一个记录行中的字符样式、宽度、大小、指定数据显示的格式(如：我有得格式中要求显示格式为‘货币’格式)
9 个解决方案
#1
各路英雄~~~帮忙指点，，我是个初学者。
#2
.rowsel
#3
lRow=grd.MouseRow
lCol=grd.MouseCol
#4
'大概的程序代码如下所示:
Private Sub MSHFlexGrid1_DblClick()
If MSHFlexGrid1.Row > 0 And MSHFlexGrid1.Col > 0 Then
MSHFlexGrid1.Col = 1 '指定列,得到当前行第二列的内容text
With Rs_Jc_Cytzs
.MoveFirst
.Find "hth='" & MSHFlexGrid1.Text & "'" '在数据库中找到这条记录
End With
Call Jc_Cytzs_GetText '调用其它过程，将此条记录内容赋予详细记录的窗体
Unload Me
End If
End Sub
Private Sub MSHFlexGrid1_DblClick()
If MSHFlexGrid1.Row > 0 And MSHFlexGrid1.Col > 0 Then
MSHFlexGrid1.Col = 1 '指定列,得到当前行第二列的内容text
With Rs_Jc_Cytzs
.MoveFirst
.Find "hth='" & MSHFlexGrid1.Text & "'" '在数据库中找到这条记录
End With
Call Jc_Cytzs_GetText '调用其它过程，将此条记录内容赋予详细记录的窗体
Unload Me
End If
End Sub
#5
1:在selchange事件里设置
MFGrid.RowSel = MFGrid.Row
2:
MFGrid.ColWidth(0) = 350
MFGrid.ColAlignment(1) = 4
MFGrid.ColAlignmentFixed(1) = 4
MFGrid.TextMatrix(0, 1)="asds"
等等
至于货币格式用format格式化好后用TextMatrix添到flexgrid
MFGrid.RowSel = MFGrid.Row
2:
MFGrid.ColWidth(0) = 350
MFGrid.ColAlignment(1) = 4
MFGrid.ColAlignmentFixed(1) = 4
MFGrid.TextMatrix(0, 1)="asds"
等等
至于货币格式用format格式化好后用TextMatrix添到flexgrid
#6
要得到'鼠标双击'MSFlexGrid1控件所得到的行，可用.MouseRow属性。
#7
给你一个例子，里面你所说的功能基本上都实现了；
Option Explicit
Dim mintcount As Integer 'The count of select from tempdo table
Dim mintPrevclick As Integer 'The previous click number in flexgrid.
Private Sub cmdDel_Click()
Dim strsql As String
Dim objCmd As New ADODB.Command
Dim rsResult As ADODB.Recordset
If MsgBox("Are you Sure to DELETE?", vbInformation + vbYesNo + vbDefaultButton2, "Delete?") = vbYes Then
strsql = "Update tempDO set IsValid = '1' where DoNo = '" & gstrTempDoNo & "'"
mintPrevclick = 0
objCmd.CommandType = adCmdText
objCmd.ActiveConnection = gobjdbcn
objCmd.CommandTimeout = 300
objCmd.CommandText = strsql
objCmd.Execute
MsgBox "Delete completed!"
objCmd.Cancel
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call mFillHeader
Call RecordBind(strsql)
Else
Exit Sub
End If
End Sub
Private Sub cmdedit_Click()
Dim strsql As String
Load FrmEdit
FrmEdit.Show
If gblncancel = True Then
gblncancel = False
Exit Sub
End If
mintPrevclick = 0
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call RecordBind(strsql)
cmdedit.Enabled = False
CmdDel.Enabled = False
End Sub
Private Sub cmdnew_Click()
Dim strsql As String
'Unload Me
Load FrmNew
FrmNew.Show
If gblncancel = True Then
gblncancel = False
Exit Sub
End If
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call RecordBind(strsql)
cmdedit.Enabled = False
CmdDel.Enabled = False
End Sub
Private Sub cmdSearch_Click()
Dim sqlstr As String
Call flexClear
Call mFillHeader
If txtJobID.Text <> "All" Then
If Not IsNumeric(txtJobID.Text) Then
MsgBox " Job ID is not Numeric!!"
txtJobID.SetFocus
Exit Sub
End If
End If
If dtpDetailF.Value > dtpDetailT.Value Then
MsgBox "Date error!"
cmdSearch.Enabled = True
Exit Sub
End If
sqlstr = "select * from tempdo where (Udatetime>= #" & dtpDetailF.Value & "# and Udatetime<= #" & dtpDetailT.Value & "#) and isValid = '0'"
If (txtJobID.Text = "All" Or txtJobID.Text = "") Then
sqlstr = sqlstr
Else
sqlstr = sqlstr & " and JobNo =" & txtJobID.Text & ""
End If
If (txtDONO.Text = "All" Or txtDONO.Text = "") Then
sqlstr = sqlstr
Else
sqlstr = sqlstr & " and DoNo ='" & txtDONO.Text & "'"
End If
Debug.Print sqlstr
Call RecordBind(sqlstr)
End Sub
Private Sub cmdUpload_Click()
Call gUpdateTempDo
Unload Me
FrmUploadRe.Show
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim strsql As String
gblncancel = False
Call mFillHeader
msgDetail.AllowUserResizing = flexResizeBoth
msgDetail.Enabled = False
cmdedit.Enabled = False
CmdDel.Enabled = False
cmdUpload.Enabled = False
txtJobID.Text = "All"
txtDONO.Text = "All"
dtpDetailF.Value = Date
dtpDetailT.Value = Date
End Sub
Private Sub RecordBind(strsql As String)
Dim objCmd As New ADODB.Command
Dim rsResult As ADODB.Recordset
Dim row As Integer
Dim i As Integer
row = 1
' Call gdbconnect
objCmd.CommandType = adCmdText
objCmd.ActiveConnection = gobjdbcn
objCmd.CommandTimeout = 300
objCmd.CommandText = strsql
Set rsResult = objCmd.Execute
mintcount = 0
Do While Not rsResult.EOF
mintcount = mintcount + 1
rsResult.MoveNext
Loop
If mintcount = 0 Then
' MsgBox "No records!"
Call flexClear
Call mFillHeader
msgDetail.Enabled = False
cmdedit.Enabled = False
CmdDel.Enabled = False
cmdUpload.Enabled = False
rsResult.Close
Set rsResult = Nothing
'gobjdbcn.Close
Exit Sub
End If
rsResult.MoveFirst
msgDetail.Enabled = True
For i = 1 To mintcount
If Not rsResult.EOF Then
msgDetail.row = row
msgDetail.AddItem "", row
addNewRecord rsResult.Fields
row = row + 1
rsResult.MoveNext
End If
Next
msgDetail.RemoveItem row
rsResult.Close
Set rsResult = Nothing
' cmdedit.Enabled = True
' cmdDel.Enabled = True
cmdUpload.Enabled = True
'gobjdbcn.Close
End Sub
Option Explicit
Dim mintcount As Integer 'The count of select from tempdo table
Dim mintPrevclick As Integer 'The previous click number in flexgrid.
Private Sub cmdDel_Click()
Dim strsql As String
Dim objCmd As New ADODB.Command
Dim rsResult As ADODB.Recordset
If MsgBox("Are you Sure to DELETE?", vbInformation + vbYesNo + vbDefaultButton2, "Delete?") = vbYes Then
strsql = "Update tempDO set IsValid = '1' where DoNo = '" & gstrTempDoNo & "'"
mintPrevclick = 0
objCmd.CommandType = adCmdText
objCmd.ActiveConnection = gobjdbcn
objCmd.CommandTimeout = 300
objCmd.CommandText = strsql
objCmd.Execute
MsgBox "Delete completed!"
objCmd.Cancel
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call mFillHeader
Call RecordBind(strsql)
Else
Exit Sub
End If
End Sub
Private Sub cmdedit_Click()
Dim strsql As String
Load FrmEdit
FrmEdit.Show
If gblncancel = True Then
gblncancel = False
Exit Sub
End If
mintPrevclick = 0
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call RecordBind(strsql)
cmdedit.Enabled = False
CmdDel.Enabled = False
End Sub
Private Sub cmdnew_Click()
Dim strsql As String
'Unload Me
Load FrmNew
FrmNew.Show
If gblncancel = True Then
gblncancel = False
Exit Sub
End If
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call RecordBind(strsql)
cmdedit.Enabled = False
CmdDel.Enabled = False
End Sub
Private Sub cmdSearch_Click()
Dim sqlstr As String
Call flexClear
Call mFillHeader
If txtJobID.Text <> "All" Then
If Not IsNumeric(txtJobID.Text) Then
MsgBox " Job ID is not Numeric!!"
txtJobID.SetFocus
Exit Sub
End If
End If
If dtpDetailF.Value > dtpDetailT.Value Then
MsgBox "Date error!"
cmdSearch.Enabled = True
Exit Sub
End If
sqlstr = "select * from tempdo where (Udatetime>= #" & dtpDetailF.Value & "# and Udatetime<= #" & dtpDetailT.Value & "#) and isValid = '0'"
If (txtJobID.Text = "All" Or txtJobID.Text = "") Then
sqlstr = sqlstr
Else
sqlstr = sqlstr & " and JobNo =" & txtJobID.Text & ""
End If
If (txtDONO.Text = "All" Or txtDONO.Text = "") Then
sqlstr = sqlstr
Else
sqlstr = sqlstr & " and DoNo ='" & txtDONO.Text & "'"
End If
Debug.Print sqlstr
Call RecordBind(sqlstr)
End Sub
Private Sub cmdUpload_Click()
Call gUpdateTempDo
Unload Me
FrmUploadRe.Show
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim strsql As String
gblncancel = False
Call mFillHeader
msgDetail.AllowUserResizing = flexResizeBoth
msgDetail.Enabled = False
cmdedit.Enabled = False
CmdDel.Enabled = False
cmdUpload.Enabled = False
txtJobID.Text = "All"
txtDONO.Text = "All"
dtpDetailF.Value = Date
dtpDetailT.Value = Date
End Sub
Private Sub RecordBind(strsql As String)
Dim objCmd As New ADODB.Command
Dim rsResult As ADODB.Recordset
Dim row As Integer
Dim i As Integer
row = 1
' Call gdbconnect
objCmd.CommandType = adCmdText
objCmd.ActiveConnection = gobjdbcn
objCmd.CommandTimeout = 300
objCmd.CommandText = strsql
Set rsResult = objCmd.Execute
mintcount = 0
Do While Not rsResult.EOF
mintcount = mintcount + 1
rsResult.MoveNext
Loop
If mintcount = 0 Then
' MsgBox "No records!"
Call flexClear
Call mFillHeader
msgDetail.Enabled = False
cmdedit.Enabled = False
CmdDel.Enabled = False
cmdUpload.Enabled = False
rsResult.Close
Set rsResult = Nothing
'gobjdbcn.Close
Exit Sub
End If
rsResult.MoveFirst
msgDetail.Enabled = True
For i = 1 To mintcount
If Not rsResult.EOF Then
msgDetail.row = row
msgDetail.AddItem "", row
addNewRecord rsResult.Fields
row = row + 1
rsResult.MoveNext
End If
Next
msgDetail.RemoveItem row
rsResult.Close
Set rsResult = Nothing
' cmdedit.Enabled = True
' cmdDel.Enabled = True
cmdUpload.Enabled = True
'gobjdbcn.Close
End Sub
#8
Private Sub addNewRecord(F As ADODB.Fields)
Dim col As ColorConstants
Dim colindex As Integer
colindex = 0
msgDetail.col = colindex
If IsNull(F("JobNo")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("JobNo")
End If
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("DoNo")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("DoNo")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("ProdNo")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("ProdNo")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("ProdVer")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("ProdVer")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("Balance")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("Balance")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("ActQty")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("ActQty")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("ActDatetime")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("ActDatetime")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("HtNo")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("HtNo")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("Type")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("Type")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
End Sub
Private Sub flexClear()
Dim i As Integer
While msgDetail.Rows > 2
msgDetail.RemoveItem msgDetail.Rows
Wend
msgDetail.Rows = 2
For i = 0 To 8
msgDetail.col = i
msgDetail.Text = " "
msgDetail.CellBackColor = Default
Next
End Sub
Private Sub msgDetail_Click()
Dim col As Integer
mintcount = msgDetail.row
msgDetail.row = mintPrevclick
For col = 0 To 8
msgDetail.col = col
msgDetail.CellBackColor = Default
Next
msgDetail.row = mintcount
Call RecordPick
Debug.Print gstrTempDoNo
End Sub
Private Sub msgDetail_DblClick()
Call cmdedit_Click
Debug.Print gstrTempDoNo
End Sub
Private Sub RecordPick()
Dim i As Integer
Dim col As Integer
Dim intclick As Integer
intclick = msgDetail.row
mintPrevclick = msgDetail.row
If gstrTempDoNo <> "" Then
gstrTempDoNo = ""
' For i = 0 To mintcount
' msgDetail.row = i
' For col = 0 To 8
' msgDetail.col = col
' msgDetail.CellBackColor = Default
' Next
' Next
End If
msgDetail.row = intclick
msgDetail.col = 1
gstrTempDoNo = msgDetail.Text
For col = 0 To 8
msgDetail.col = col
msgDetail.CellBackColor = vbYellow
Next
cmdedit.Enabled = True
CmdDel.Enabled = True
End Sub
Private Sub mFillHeader()
msgDetail.row = 0
msgDetail.ColWidth(0) = 400
msgDetail.col = 0
msgDetail.Text = "Job ID"
msgDetail.ColWidth(0) = (msgDetail.Width - 400) * 5 / 100
msgDetail.col = 1
msgDetail.Text = "D/O"
msgDetail.ColWidth(1) = (msgDetail.Width - 400) * 10 / 100
msgDetail.col = 2
msgDetail.Text = "Product Number"
msgDetail.ColWidth(2) = (msgDetail.Width - 400) * 15 / 100
msgDetail.col = 3
msgDetail.Text = "Product Version"
msgDetail.ColWidth(3) = (msgDetail.Width - 400) * 13 / 100
msgDetail.col = 4
msgDetail.Text = "Balance"
msgDetail.ColWidth(4) = (msgDetail.Width - 400) * 10 / 100
msgDetail.col = 5
msgDetail.Text = "Actual Qty"
msgDetail.ColWidth(5) = (msgDetail.Width - 400) * 10 / 100
msgDetail.col = 6
msgDetail.Text = "Actual Datetime"
msgDetail.ColWidth(6) = (msgDetail.Width - 400) * 20 / 100
msgDetail.col = 7
msgDetail.Text = "Handy No"
msgDetail.ColWidth(7) = (msgDetail.Width - 400) * 10 / 100
msgDetail.col = 8
msgDetail.Text = "Type"
msgDetail.ColWidth(8) = (msgDetail.Width - 400) * 10 / 100
End Sub
#9
问题2：如何让MSFlexGrid控件中，根据单元格字符的多少来自动得调整它的宽度。
With MSFlexGrid1
.ColWidth(6) = Len(.TextMatrix(.Rows - 1, 6))
End With
'这里只能求得单元格里字符的长度(14)，如果根据这个宽度来调整单元格的宽度可见是不行的。
请教大家如何的实现上述功能~
With MSFlexGrid1
.ColWidth(6) = Len(.TextMatrix(.Rows - 1, 6))
End With
'这里只能求得单元格里字符的长度(14)，如果根据这个宽度来调整单元格的宽度可见是不行的。
请教大家如何的实现上述功能~
#1
各路英雄~~~帮忙指点，，我是个初学者。
#2
.rowsel
#3
lRow=grd.MouseRow
lCol=grd.MouseCol
#4
'大概的程序代码如下所示:
Private Sub MSHFlexGrid1_DblClick()
If MSHFlexGrid1.Row > 0 And MSHFlexGrid1.Col > 0 Then
MSHFlexGrid1.Col = 1 '指定列,得到当前行第二列的内容text
With Rs_Jc_Cytzs
.MoveFirst
.Find "hth='" & MSHFlexGrid1.Text & "'" '在数据库中找到这条记录
End With
Call Jc_Cytzs_GetText '调用其它过程，将此条记录内容赋予详细记录的窗体
Unload Me
End If
End Sub
Private Sub MSHFlexGrid1_DblClick()
If MSHFlexGrid1.Row > 0 And MSHFlexGrid1.Col > 0 Then
MSHFlexGrid1.Col = 1 '指定列,得到当前行第二列的内容text
With Rs_Jc_Cytzs
.MoveFirst
.Find "hth='" & MSHFlexGrid1.Text & "'" '在数据库中找到这条记录
End With
Call Jc_Cytzs_GetText '调用其它过程，将此条记录内容赋予详细记录的窗体
Unload Me
End If
End Sub
#5
1:在selchange事件里设置
MFGrid.RowSel = MFGrid.Row
2:
MFGrid.ColWidth(0) = 350
MFGrid.ColAlignment(1) = 4
MFGrid.ColAlignmentFixed(1) = 4
MFGrid.TextMatrix(0, 1)="asds"
等等
至于货币格式用format格式化好后用TextMatrix添到flexgrid
MFGrid.RowSel = MFGrid.Row
2:
MFGrid.ColWidth(0) = 350
MFGrid.ColAlignment(1) = 4
MFGrid.ColAlignmentFixed(1) = 4
MFGrid.TextMatrix(0, 1)="asds"
等等
至于货币格式用format格式化好后用TextMatrix添到flexgrid
#6
要得到'鼠标双击'MSFlexGrid1控件所得到的行，可用.MouseRow属性。
#7
给你一个例子，里面你所说的功能基本上都实现了；
Option Explicit
Dim mintcount As Integer 'The count of select from tempdo table
Dim mintPrevclick As Integer 'The previous click number in flexgrid.
Private Sub cmdDel_Click()
Dim strsql As String
Dim objCmd As New ADODB.Command
Dim rsResult As ADODB.Recordset
If MsgBox("Are you Sure to DELETE?", vbInformation + vbYesNo + vbDefaultButton2, "Delete?") = vbYes Then
strsql = "Update tempDO set IsValid = '1' where DoNo = '" & gstrTempDoNo & "'"
mintPrevclick = 0
objCmd.CommandType = adCmdText
objCmd.ActiveConnection = gobjdbcn
objCmd.CommandTimeout = 300
objCmd.CommandText = strsql
objCmd.Execute
MsgBox "Delete completed!"
objCmd.Cancel
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call mFillHeader
Call RecordBind(strsql)
Else
Exit Sub
End If
End Sub
Private Sub cmdedit_Click()
Dim strsql As String
Load FrmEdit
FrmEdit.Show
If gblncancel = True Then
gblncancel = False
Exit Sub
End If
mintPrevclick = 0
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call RecordBind(strsql)
cmdedit.Enabled = False
CmdDel.Enabled = False
End Sub
Private Sub cmdnew_Click()
Dim strsql As String
'Unload Me
Load FrmNew
FrmNew.Show
If gblncancel = True Then
gblncancel = False
Exit Sub
End If
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call RecordBind(strsql)
cmdedit.Enabled = False
CmdDel.Enabled = False
End Sub
Private Sub cmdSearch_Click()
Dim sqlstr As String
Call flexClear
Call mFillHeader
If txtJobID.Text <> "All" Then
If Not IsNumeric(txtJobID.Text) Then
MsgBox " Job ID is not Numeric!!"
txtJobID.SetFocus
Exit Sub
End If
End If
If dtpDetailF.Value > dtpDetailT.Value Then
MsgBox "Date error!"
cmdSearch.Enabled = True
Exit Sub
End If
sqlstr = "select * from tempdo where (Udatetime>= #" & dtpDetailF.Value & "# and Udatetime<= #" & dtpDetailT.Value & "#) and isValid = '0'"
If (txtJobID.Text = "All" Or txtJobID.Text = "") Then
sqlstr = sqlstr
Else
sqlstr = sqlstr & " and JobNo =" & txtJobID.Text & ""
End If
If (txtDONO.Text = "All" Or txtDONO.Text = "") Then
sqlstr = sqlstr
Else
sqlstr = sqlstr & " and DoNo ='" & txtDONO.Text & "'"
End If
Debug.Print sqlstr
Call RecordBind(sqlstr)
End Sub
Private Sub cmdUpload_Click()
Call gUpdateTempDo
Unload Me
FrmUploadRe.Show
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim strsql As String
gblncancel = False
Call mFillHeader
msgDetail.AllowUserResizing = flexResizeBoth
msgDetail.Enabled = False
cmdedit.Enabled = False
CmdDel.Enabled = False
cmdUpload.Enabled = False
txtJobID.Text = "All"
txtDONO.Text = "All"
dtpDetailF.Value = Date
dtpDetailT.Value = Date
End Sub
Private Sub RecordBind(strsql As String)
Dim objCmd As New ADODB.Command
Dim rsResult As ADODB.Recordset
Dim row As Integer
Dim i As Integer
row = 1
' Call gdbconnect
objCmd.CommandType = adCmdText
objCmd.ActiveConnection = gobjdbcn
objCmd.CommandTimeout = 300
objCmd.CommandText = strsql
Set rsResult = objCmd.Execute
mintcount = 0
Do While Not rsResult.EOF
mintcount = mintcount + 1
rsResult.MoveNext
Loop
If mintcount = 0 Then
' MsgBox "No records!"
Call flexClear
Call mFillHeader
msgDetail.Enabled = False
cmdedit.Enabled = False
CmdDel.Enabled = False
cmdUpload.Enabled = False
rsResult.Close
Set rsResult = Nothing
'gobjdbcn.Close
Exit Sub
End If
rsResult.MoveFirst
msgDetail.Enabled = True
For i = 1 To mintcount
If Not rsResult.EOF Then
msgDetail.row = row
msgDetail.AddItem "", row
addNewRecord rsResult.Fields
row = row + 1
rsResult.MoveNext
End If
Next
msgDetail.RemoveItem row
rsResult.Close
Set rsResult = Nothing
' cmdedit.Enabled = True
' cmdDel.Enabled = True
cmdUpload.Enabled = True
'gobjdbcn.Close
End Sub
Option Explicit
Dim mintcount As Integer 'The count of select from tempdo table
Dim mintPrevclick As Integer 'The previous click number in flexgrid.
Private Sub cmdDel_Click()
Dim strsql As String
Dim objCmd As New ADODB.Command
Dim rsResult As ADODB.Recordset
If MsgBox("Are you Sure to DELETE?", vbInformation + vbYesNo + vbDefaultButton2, "Delete?") = vbYes Then
strsql = "Update tempDO set IsValid = '1' where DoNo = '" & gstrTempDoNo & "'"
mintPrevclick = 0
objCmd.CommandType = adCmdText
objCmd.ActiveConnection = gobjdbcn
objCmd.CommandTimeout = 300
objCmd.CommandText = strsql
objCmd.Execute
MsgBox "Delete completed!"
objCmd.Cancel
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call mFillHeader
Call RecordBind(strsql)
Else
Exit Sub
End If
End Sub
Private Sub cmdedit_Click()
Dim strsql As String
Load FrmEdit
FrmEdit.Show
If gblncancel = True Then
gblncancel = False
Exit Sub
End If
mintPrevclick = 0
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call RecordBind(strsql)
cmdedit.Enabled = False
CmdDel.Enabled = False
End Sub
Private Sub cmdnew_Click()
Dim strsql As String
'Unload Me
Load FrmNew
FrmNew.Show
If gblncancel = True Then
gblncancel = False
Exit Sub
End If
strsql = "Select * from tempdo where (Udatetime >= #" & dtpDetailF.Value & "# and Udatetime <= #" & dtpDetailT.Value & "#) and isValid = '0'"
Call flexClear
Call RecordBind(strsql)
cmdedit.Enabled = False
CmdDel.Enabled = False
End Sub
Private Sub cmdSearch_Click()
Dim sqlstr As String
Call flexClear
Call mFillHeader
If txtJobID.Text <> "All" Then
If Not IsNumeric(txtJobID.Text) Then
MsgBox " Job ID is not Numeric!!"
txtJobID.SetFocus
Exit Sub
End If
End If
If dtpDetailF.Value > dtpDetailT.Value Then
MsgBox "Date error!"
cmdSearch.Enabled = True
Exit Sub
End If
sqlstr = "select * from tempdo where (Udatetime>= #" & dtpDetailF.Value & "# and Udatetime<= #" & dtpDetailT.Value & "#) and isValid = '0'"
If (txtJobID.Text = "All" Or txtJobID.Text = "") Then
sqlstr = sqlstr
Else
sqlstr = sqlstr & " and JobNo =" & txtJobID.Text & ""
End If
If (txtDONO.Text = "All" Or txtDONO.Text = "") Then
sqlstr = sqlstr
Else
sqlstr = sqlstr & " and DoNo ='" & txtDONO.Text & "'"
End If
Debug.Print sqlstr
Call RecordBind(sqlstr)
End Sub
Private Sub cmdUpload_Click()
Call gUpdateTempDo
Unload Me
FrmUploadRe.Show
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim strsql As String
gblncancel = False
Call mFillHeader
msgDetail.AllowUserResizing = flexResizeBoth
msgDetail.Enabled = False
cmdedit.Enabled = False
CmdDel.Enabled = False
cmdUpload.Enabled = False
txtJobID.Text = "All"
txtDONO.Text = "All"
dtpDetailF.Value = Date
dtpDetailT.Value = Date
End Sub
Private Sub RecordBind(strsql As String)
Dim objCmd As New ADODB.Command
Dim rsResult As ADODB.Recordset
Dim row As Integer
Dim i As Integer
row = 1
' Call gdbconnect
objCmd.CommandType = adCmdText
objCmd.ActiveConnection = gobjdbcn
objCmd.CommandTimeout = 300
objCmd.CommandText = strsql
Set rsResult = objCmd.Execute
mintcount = 0
Do While Not rsResult.EOF
mintcount = mintcount + 1
rsResult.MoveNext
Loop
If mintcount = 0 Then
' MsgBox "No records!"
Call flexClear
Call mFillHeader
msgDetail.Enabled = False
cmdedit.Enabled = False
CmdDel.Enabled = False
cmdUpload.Enabled = False
rsResult.Close
Set rsResult = Nothing
'gobjdbcn.Close
Exit Sub
End If
rsResult.MoveFirst
msgDetail.Enabled = True
For i = 1 To mintcount
If Not rsResult.EOF Then
msgDetail.row = row
msgDetail.AddItem "", row
addNewRecord rsResult.Fields
row = row + 1
rsResult.MoveNext
End If
Next
msgDetail.RemoveItem row
rsResult.Close
Set rsResult = Nothing
' cmdedit.Enabled = True
' cmdDel.Enabled = True
cmdUpload.Enabled = True
'gobjdbcn.Close
End Sub
#8
Private Sub addNewRecord(F As ADODB.Fields)
Dim col As ColorConstants
Dim colindex As Integer
colindex = 0
msgDetail.col = colindex
If IsNull(F("JobNo")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("JobNo")
End If
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("DoNo")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("DoNo")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("ProdNo")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("ProdNo")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("ProdVer")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("ProdVer")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("Balance")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("Balance")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("ActQty")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("ActQty")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("ActDatetime")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("ActDatetime")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("HtNo")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("HtNo")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
colindex = colindex + 1
msgDetail.col = colindex
If IsNull(F("Type")) Then
msgDetail.Text = ""
Else
msgDetail.Text = F("Type")
End If
msgDetail.CellAlignment = 8
msgDetail.CellBackColor = col
End Sub
Private Sub flexClear()
Dim i As Integer
While msgDetail.Rows > 2
msgDetail.RemoveItem msgDetail.Rows
Wend
msgDetail.Rows = 2
For i = 0 To 8
msgDetail.col = i
msgDetail.Text = " "
msgDetail.CellBackColor = Default
Next
End Sub
Private Sub msgDetail_Click()
Dim col As Integer
mintcount = msgDetail.row
msgDetail.row = mintPrevclick
For col = 0 To 8
msgDetail.col = col
msgDetail.CellBackColor = Default
Next
msgDetail.row = mintcount
Call RecordPick
Debug.Print gstrTempDoNo
End Sub
Private Sub msgDetail_DblClick()
Call cmdedit_Click
Debug.Print gstrTempDoNo
End Sub
Private Sub RecordPick()
Dim i As Integer
Dim col As Integer
Dim intclick As Integer
intclick = msgDetail.row
mintPrevclick = msgDetail.row
If gstrTempDoNo <> "" Then
gstrTempDoNo = ""
' For i = 0 To mintcount
' msgDetail.row = i
' For col = 0 To 8
' msgDetail.col = col
' msgDetail.CellBackColor = Default
' Next
' Next
End If
msgDetail.row = intclick
msgDetail.col = 1
gstrTempDoNo = msgDetail.Text
For col = 0 To 8
msgDetail.col = col
msgDetail.CellBackColor = vbYellow
Next
cmdedit.Enabled = True
CmdDel.Enabled = True
End Sub
Private Sub mFillHeader()
msgDetail.row = 0
msgDetail.ColWidth(0) = 400
msgDetail.col = 0
msgDetail.Text = "Job ID"
msgDetail.ColWidth(0) = (msgDetail.Width - 400) * 5 / 100
msgDetail.col = 1
msgDetail.Text = "D/O"
msgDetail.ColWidth(1) = (msgDetail.Width - 400) * 10 / 100
msgDetail.col = 2
msgDetail.Text = "Product Number"
msgDetail.ColWidth(2) = (msgDetail.Width - 400) * 15 / 100
msgDetail.col = 3
msgDetail.Text = "Product Version"
msgDetail.ColWidth(3) = (msgDetail.Width - 400) * 13 / 100
msgDetail.col = 4
msgDetail.Text = "Balance"
msgDetail.ColWidth(4) = (msgDetail.Width - 400) * 10 / 100
msgDetail.col = 5
msgDetail.Text = "Actual Qty"
msgDetail.ColWidth(5) = (msgDetail.Width - 400) * 10 / 100
msgDetail.col = 6
msgDetail.Text = "Actual Datetime"
msgDetail.ColWidth(6) = (msgDetail.Width - 400) * 20 / 100
msgDetail.col = 7
msgDetail.Text = "Handy No"
msgDetail.ColWidth(7) = (msgDetail.Width - 400) * 10 / 100
msgDetail.col = 8
msgDetail.Text = "Type"
msgDetail.ColWidth(8) = (msgDetail.Width - 400) * 10 / 100
End Sub
#9
问题2：如何让MSFlexGrid控件中，根据单元格字符的多少来自动得调整它的宽度。
With MSFlexGrid1
.ColWidth(6) = Len(.TextMatrix(.Rows - 1, 6))
End With
'这里只能求得单元格里字符的长度(14)，如果根据这个宽度来调整单元格的宽度可见是不行的。
请教大家如何的实现上述功能~
With MSFlexGrid1
.ColWidth(6) = Len(.TextMatrix(.Rows - 1, 6))
End With
'这里只能求得单元格里字符的长度(14)，如果根据这个宽度来调整单元格的宽度可见是不行的。
请教大家如何的实现上述功能~