?? frmzcsy.frm
字號(hào):
Grid2.TextMatrix(Y, 2) = Format(0, "###0.00")
Grid2.TextMatrix(Y, 3) = Format(0, "###0.00")
If Y = 1 Or Y = 15 Or Y = 17 Or Y = 18 Or Y = 25 Or Y = 28 Or Y = 29 Or Y = 30 Then
Grid2.TextMatrix(Y, 2) = ""
Grid2.TextMatrix(Y, 3) = ""
Else
End If
Next Y
loadyearstar
End Sub
Private Sub Grid1_DblClick()
' Move the text box to the current grid cell:
Text1.Top = Grid1.CellTop + Grid1.Top + SSTab1.Top
Text1.Left = Grid1.CellLeft + Grid1.Left + SSTab1.Left
' Save the position of the grids Row and Col for later:
gRow = Grid1.Row
gCol = Grid1.Col
If gRow = 1 And gCol = 2 Then Exit Sub
If gRow = 1 And gCol = 3 Then Exit Sub
If gRow = 18 And gCol = 2 Then Exit Sub
If gRow = 18 And gCol = 3 Then Exit Sub
If gRow = 19 And gCol = 2 Then Exit Sub
If gRow = 19 And gCol = 3 Then Exit Sub
If gRow = 28 And gCol = 2 Then Exit Sub
If gRow = 28 And gCol = 3 Then Exit Sub
If gRow = 33 And gCol = 2 Then Exit Sub
If gRow = 33 And gCol = 3 Then Exit Sub
If gRow = 32 And gCol = 2 Then Exit Sub
If gRow = 32 And gCol = 3 Then Exit Sub
If gRow = 34 And gCol = 2 Then Exit Sub
If gRow = 34 And gCol = 3 Then Exit Sub
If gRow = 7 And gCol = 2 Then Exit Sub
If gRow = 7 And gCol = 3 Then Exit Sub
If gRow = 21 And gCol = 2 Then Exit Sub
If gRow = 21 And gCol = 3 Then Exit Sub
If gRow = 24 And gCol = 2 Then Exit Sub
If gRow = 24 And gCol = 3 Then Exit Sub
If gRow = 29 And gCol = 2 Then Exit Sub
If gRow = 29 And gCol = 3 Then Exit Sub
If gRow = 35 And gCol = 2 Then Exit Sub
If gRow = 35 And gCol = 3 Then Exit Sub
If gRow = 37 And gCol = 2 Then Exit Sub
If gRow = 37 And gCol = 3 Then Exit Sub
' Make text box same size as current grid cell:
Text1.Width = Grid1.CellWidth '- 2 * Screen.TwipsPerPixelX
Text1.Height = Grid1.CellHeight ' - 2 * Screen.TwipsPerPixelY
' Transfer the grid cell text:
Text1.Text = Grid1.Text
' Show the text box:
Text1.Visible = True
Text1.ZOrder 0 ' 把 Text1 放到最前面!
Text1.SetFocus
' Redirect this KeyPress event to the text box:
If KeyAscii <> ASC_ENTER Then
SendKeys Chr$(KeyAscii)
End If
End Sub
Private Sub Cmdback_Click()
Unload Me
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub
Private Sub Grid1_KeyPress(KeyAscii As Integer)
Call Grid1_DblClick
End Sub
Private Sub Text10_GotFocus()
Text10.SelStart = 0
Text10.SelLength = Len(Text10)
End Sub
Private Sub Grid2_KeyPress(KeyAscii As Integer)
Call Grid2_DblClick
End Sub
Private Sub Text10_KeyPress(KeyAscii As Integer)
If KeyAscii = ASC_ENTER Then
Grid2.SetFocus ' Set focus back to grid, see Text_LostFocus.
KeyAscii = 0 ' Ignore this KeyPress.
End If
If KeyAscii <> 8 And KeyAscii <> 45 And KeyAscii <> 46 And KeyAscii < 48 Or KeyAscii > 57 Then
' 'Beep
KeyAscii = 0
End If
End Sub
'6 增加代碼到 Text1_KeyPress 過程:
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = ASC_ENTER Then
Grid1.SetFocus ' Set focus back to grid, see Text_LostFocus.
KeyAscii = 0 ' Ignore this KeyPress.
End If
If KeyAscii <> 8 And KeyAscii <> 45 And KeyAscii <> 46 And KeyAscii < 48 Or KeyAscii > 57 Then
' 'Beep
KeyAscii = 0
End If
End Sub
'7 增加代碼到 Text1_LostFocus 過程:
Private Sub Text1_LostFocus()
Dim tmpRow As Integer
Dim tmpCol As Integer
' Save current settings of Grid Row and col. This is needed only if
' the focus is set somewhere else in the Grid.
tmpRow = Grid1.Row
tmpCol = Grid1.Col
' Set Row and Col back to what they were before Text1_LostFocus:
Grid1.Row = gRow
Grid1.Col = gCol
Grid1.Text = Format(Text1.Text, "###0.00") ' Transfer text back to grid.
Text1.SelStart = 0 ' Return caret to beginning.
Text1.Visible = False ' Disable text box.
' Return row and Col contents:
Grid1.Row = tmpRow
Grid1.Col = tmpCol
Grid1.TextMatrix(7, 2) = Format(Val(Grid1.TextMatrix(5, 2)) - Val(Grid1.TextMatrix(6, 2)), "###0.00")
Grid1.TextMatrix(7, 3) = Format(Val(Grid1.TextMatrix(5, 3)) - Val(Grid1.TextMatrix(6, 3)), "###0.00")
Grid1.TextMatrix(18, 2) = Format(Val(Grid1.TextMatrix(7, 2)) + Val(Grid1.TextMatrix(8, 2)) + Val(Grid1.TextMatrix(9, 2)) + Val(Grid1.TextMatrix(10, 2)) + Val(Grid1.TextMatrix(11, 2)) + Val(Grid1.TextMatrix(12, 2)) + Val(Grid1.TextMatrix(13, 2)) + Val(Grid1.TextMatrix(14, 2)) + Val(Grid1.TextMatrix(15, 2)) + Val(Grid1.TextMatrix(16, 2)) + Val(Grid1.TextMatrix(17, 2)) + Val(Grid1.TextMatrix(2, 2)) + Val(Grid1.TextMatrix(3, 2)) + Val(Grid1.TextMatrix(4, 2)), "###0.00")
Grid1.TextMatrix(18, 3) = Format(Val(Grid1.TextMatrix(7, 3)) + Val(Grid1.TextMatrix(8, 3)) + Val(Grid1.TextMatrix(9, 3)) + Val(Grid1.TextMatrix(10, 3)) + Val(Grid1.TextMatrix(11, 3)) + Val(Grid1.TextMatrix(12, 3)) + Val(Grid1.TextMatrix(13, 3)) + Val(Grid1.TextMatrix(14, 3)) + Val(Grid1.TextMatrix(15, 3)) + Val(Grid1.TextMatrix(16, 3)) + Val(Grid1.TextMatrix(17, 3)) + Val(Grid1.TextMatrix(2, 3)) + Val(Grid1.TextMatrix(3, 3)) + Val(Grid1.TextMatrix(4, 3)), "###0.00")
Grid1.TextMatrix(24, 2) = Format(Val(Grid1.TextMatrix(22, 2)) - Val(Grid1.TextMatrix(23, 2)), "###0.00")
Grid1.TextMatrix(24, 3) = Format(Val(Grid1.TextMatrix(22, 3)) - Val(Grid1.TextMatrix(23, 3)), "###0.00")
Grid1.TextMatrix(28, 2) = Format(Val(Grid1.TextMatrix(24, 2)) + Val(Grid1.TextMatrix(25, 2)) + Val(Grid1.TextMatrix(26, 2)) + Val(Grid1.TextMatrix(27, 2)), "###0.00")
Grid1.TextMatrix(28, 3) = Format(Val(Grid1.TextMatrix(24, 3)) + Val(Grid1.TextMatrix(25, 3)) + Val(Grid1.TextMatrix(26, 3)) + Val(Grid1.TextMatrix(27, 3)), "###0.00")
Grid1.TextMatrix(32, 2) = Format(Val(Grid1.TextMatrix(30, 2)) + Val(Grid1.TextMatrix(31, 2)), "###0.00")
Grid1.TextMatrix(32, 3) = Format(Val(Grid1.TextMatrix(30, 3)) + Val(Grid1.TextMatrix(31, 3)), "###0.00")
Grid1.TextMatrix(37, 2) = Format(Val(Grid1.TextMatrix(18, 2)) + Val(Grid1.TextMatrix(20, 2)) + Val(Grid1.TextMatrix(28, 2)) + Val(Grid1.TextMatrix(32, 2)) + Val(Grid1.TextMatrix(34, 2)) + Val(Grid1.TextMatrix(36, 2)), "###0.00")
Grid1.TextMatrix(37, 3) = Format(Val(Grid1.TextMatrix(18, 3)) + Val(Grid1.TextMatrix(20, 3)) + Val(Grid1.TextMatrix(28, 3)) + Val(Grid1.TextMatrix(32, 3)) + Val(Grid1.TextMatrix(34, 3)) + Val(Grid1.TextMatrix(36, 3)), "###0.00")
End Sub
Private Sub Text10_LostFocus()
Dim tmpRow1 As Integer
Dim tmpCol1 As Integer
' Save current settings of Grid Row and col. This is needed only if
' the focus is set somewhere else in the Grid.
tmpRow1 = Grid2.Row
tmpCol1 = Grid2.Col
' Set Row and Col back to what they were before Text1_LostFocus:
Grid2.Row = gRow1
Grid2.Col = gCol1
Grid2.Text = Format(Text10.Text, "###0.00") ' Transfer text back to grid.
Text10.SelStart = 0 ' Return caret to beginning.
Text10.Visible = False ' Disable text box.
' Return row and Col contents:
Grid2.Row = tmpRow1
Grid2.Col = tmpCol1
Grid2.TextMatrix(16, 2) = Format(Val(Grid2.TextMatrix(2, 2)) + Val(Grid2.TextMatrix(3, 2)) + Val(Grid2.TextMatrix(4, 2)) + Val(Grid2.TextMatrix(5, 2)) + Val(Grid2.TextMatrix(6, 2)) + Val(Grid2.TextMatrix(7, 2)) + Val(Grid2.TextMatrix(8, 2)) + Val(Grid2.TextMatrix(9, 2)) + Val(Grid2.TextMatrix(10, 2)) + Val(Grid2.TextMatrix(11, 2)) + Val(Grid2.TextMatrix(12, 2)) + Val(Grid2.TextMatrix(13, 2)) + Val(Grid2.TextMatrix(14, 2)), "###0.00")
Grid2.TextMatrix(16, 3) = Format(Val(Grid2.TextMatrix(2, 3)) + Val(Grid2.TextMatrix(3, 3)) + Val(Grid2.TextMatrix(4, 3)) + Val(Grid2.TextMatrix(5, 3)) + Val(Grid2.TextMatrix(6, 3)) + Val(Grid2.TextMatrix(7, 3)) + Val(Grid2.TextMatrix(8, 3)) + Val(Grid2.TextMatrix(9, 3)) + Val(Grid2.TextMatrix(10, 3)) + Val(Grid2.TextMatrix(11, 3)) + Val(Grid2.TextMatrix(12, 3)) + Val(Grid2.TextMatrix(13, 3)) + Val(Grid2.TextMatrix(14, 3)), "###0.00")
Grid2.TextMatrix(24, 2) = Format(Val(Grid2.TextMatrix(19, 2)) + Val(Grid2.TextMatrix(20, 2)) + Val(Grid2.TextMatrix(21, 2)) + Val(Grid2.TextMatrix(22, 2)), "###0.00")
Grid2.TextMatrix(24, 3) = Format(Val(Grid2.TextMatrix(19, 3)) + Val(Grid2.TextMatrix(20, 3)) + Val(Grid2.TextMatrix(21, 3)) + Val(Grid2.TextMatrix(22, 3)), "###0.00")
Grid2.TextMatrix(27, 2) = Format(Val(Grid2.TextMatrix(16, 2)) + Val(Grid2.TextMatrix(24, 2)) + Val(Grid2.TextMatrix(26, 2)), "###0.00")
Grid2.TextMatrix(27, 3) = Format(Val(Grid2.TextMatrix(16, 3)) + Val(Grid2.TextMatrix(24, 3)) + Val(Grid2.TextMatrix(26, 3)), "###0.00")
Grid2.TextMatrix(36, 2) = Format(Val(Grid2.TextMatrix(31, 2)) + Val(Grid2.TextMatrix(32, 2)) + Val(Grid2.TextMatrix(33, 2)) + Val(Grid2.TextMatrix(35, 2)), "###0.00")
Grid2.TextMatrix(36, 3) = Format(Val(Grid2.TextMatrix(31, 3)) + Val(Grid2.TextMatrix(32, 3)) + Val(Grid2.TextMatrix(33, 3)) + Val(Grid2.TextMatrix(35, 3)), "###0.00")
Grid2.TextMatrix(37, 2) = Format(Val(Grid2.TextMatrix(27, 2)) + Val(Grid2.TextMatrix(36, 2)), "###0.00")
Grid2.TextMatrix(37, 3) = Format(Val(Grid2.TextMatrix(27, 3)) + Val(Grid2.TextMatrix(36, 3)), "###0.00")
End Sub
Private Sub Text3_GotFocus()
Text3.SelStart = 0
Text3.SelLength = Len(Text3)
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 46 And KeyAscii < 48 Or KeyAscii > 57 Then
'Beep
KeyAscii = 0
End If
End Sub
Private Sub Text3_LostFocus()
Text3 = Format(Text3.Text, "###0.00")
End Sub
Private Sub Text4_GotFocus()
Text4.SelStart = 0
Text4.SelLength = Len(Text4)
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 46 And KeyAscii < 48 Or KeyAscii > 57 Then
'Beep
KeyAscii = 0
End If
End Sub
Private Sub Text4_LostFocus()
Text4 = Format(Text4.Text, "###0.00")
End Sub
Private Sub Text5_GotFocus()
Text5.SelStart = 0
Text5.SelLength = Len(Text5)
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 46 And KeyAscii < 48 Or KeyAscii > 57 Then
'Beep
KeyAscii = 0
End If
End Sub
Private Sub Text5_LostFocus()
Text5 = Format(Text5.Text, "###0.00")
End Sub
Private Sub Text6_GotFocus()
Text6.SelStart = 0
Text6.SelLength = Len(Text6)
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 46 And KeyAscii < 48 Or KeyAscii > 57 Then
'Beep
KeyAscii = 0
End If
End Sub
Private Sub Text6_LostFocus()
Text6 = Format(Text6.Text, "###0.00")
End Sub
Private Sub Grid2_DblClick()
' Move the text box to the current grid cell:
Text10.Top = Grid2.CellTop + Grid2.Top + SSTab1.Top
Text10.Left = Grid2.CellLeft + Grid2.Left + SSTab1.Left
' Save the position of the grids Row and Col for later:
gRow1 = Grid2.Row
gCol1 = Grid2.Col
If gRow1 = 1 And gCol1 = 2 Then Exit Sub
If gRow1 = 1 And gCol1 = 3 Then Exit Sub
If gRow1 = 15 And gCol1 = 2 Then Exit Sub
If gRow1 = 15 And gCol1 = 3 Then Exit Sub
If gRow1 = 16 And gCol1 = 2 Then Exit Sub
If gRow1 = 16 And gCol1 = 3 Then Exit Sub
If gRow1 = 17 And gCol1 = 2 Then Exit Sub
If gRow1 = 17 And gCol1 = 3 Then Exit Sub
If gRow1 = 18 And gCol1 = 2 Then Exit Sub
If gRow1 = 18 And gCol1 = 3 Then Exit Sub
If gRow1 = 24 And gCol1 = 2 Then Exit Sub
If gRow1 = 24 And gCol1 = 3 Then Exit Sub
If gRow1 = 25 And gCol1 = 2 Then Exit Sub
If gRow1 = 25 And gCol1 = 3 Then Exit Sub
If gRow1 = 27 And gCol1 = 2 Then Exit Sub
If gRow1 = 27 And gCol1 = 3 Then Exit Sub
If gRow1 = 28 And gCol1 = 2 Then Exit Sub
If gRow1 = 28 And gCol1 = 3 Then Exit Sub
If gRow1 = 29 And gCol1 = 2 Then Exit Sub
If gRow1 = 29 And gCol1 = 3 Then Exit Sub
If gRow1 = 30 And gCol1 = 2 Then Exit Sub
If gRow1 = 30 And gCol1 = 3 Then Exit Sub
If gRow1 = 36 And gCol1 = 2 Then Exit Sub
If gRow1 = 36 And gCol1 = 3 Then Exit Sub
If gRow1 = 37 And gCol1 = 2 Then Exit Sub
If gRow1 = 37 And gCol1 = 3 Then Exit Sub
' Make text box same size as current grid cell:
Text10.Width = Grid2.CellWidth '- 2 * Screen.TwipsPerPixelX
Text10.Height = Grid2.CellHeight ' - 2 * Screen.TwipsPerPixelY
' Transfer the grid cell text:
Text10.Text = Grid2.Text
' Show the text box:
Text10.Visible = True
Text10.ZOrder 0 ' 把 Text1 放到最前面!
Text10.SetFocus
' Redirect this KeyPress event to the text box:
If KeyAscii <> ASC_ENTER Then
SendKeys Chr$(KeyAscii)
End If
End Sub
Private Sub loadyearstar()
'讀出數(shù)據(jù)
On Error Resume Next
Dim db As Database, EF As Recordset
Set db = OpenDatabase(Con, False, False, ConStr)
Set EF = db.OpenRecordset("shangyearstar", dbOpenTable)
Set EF = db.OpenRecordset("Select * From shangyearstar where qybm='" & frmqy.qybm & "'" & "Order BY ID", dbOpenDynaset)
i = 1
Do While Not EF.EOF
If i > Grid1.Rows Then
Grid2.Row = i - Grid1.Rows
Grid2.Col = 2
Grid2.Text = EF.Fields("shang").Value
Else
Grid1.Col = 2
Grid1.Row = i
Grid1.Text = EF.Fields("shang").Value
End If
EF.MoveNext
i = i + 1
Loop
End Sub
Private Sub SaveYearStar()
On Error Resume Next
'校對(duì)數(shù)據(jù)庫(kù)是否已經(jīng)存在該企業(yè)年初數(shù)
Dim db As Database, EF As Recordset, Saveyn As String, ShangValue As String
Set db = OpenDatabase(Con, False, False, ConStr)
Set EF = db.OpenRecordset("shangyearstar", dbOpenTable)
Set EF = db.OpenRecordset("Select * From shangyearstar where qybm='" & frmqy.qybm & "'", dbOpenDynaset)
If EF.EOF = False Then
Saveyn = MsgBox("該企業(yè)年初數(shù)已經(jīng)存在!覆蓋嗎?", vbQuestion + vbYesNo, "保存")
If Saveyn = vbNo Then Exit Sub
Else
End If
EF.Close
'刪除原來的記錄
DBEngine.BeginTrans
Set db = OpenDatabase(Con, False, False, ConStr)
db.Execute "Delete * From shangyearstar where qybm='" & frmqy.qybm & "'"
db.Close
DBEngine.CommitTrans
'保存記錄
'保存Grid1
For i = 1 To Grid1.Rows
Grid1.Col = 2
Grid1.Row = i
ShangValue = Grid1.Text
DBEngine.BeginTrans
Set db = OpenDatabase(Con, False, False, ConStr)
RecStr = "Insert into shangyearstar (shang,qybm) values('" & Trim(ShangValue) & "','" & Trim(frmqy.qybm) & "')"
db.Execute RecStr
db.Close
DBEngine.CommitTrans
Next i
'保存Grid2
For i = 1 To Grid2.Rows
Grid2.Col = 2
Grid2.Row = i
ShangValue = Grid2.Text
DBEngine.BeginTrans
Set db = OpenDatabase(Con, False, False, ConStr)
RecStr = "Insert into shangyearstar (shang,qybm) values('" & Trim(ShangValue) & "','" & Trim(frmqy.qybm) & "')"
db.Execute RecStr
db.Close
DBEngine.CommitTrans
Next i
MsgBox "您已經(jīng)成功保存企業(yè)" & frmqy.qybm & "年初數(shù)", vbOKOnly + vbCritical, "成功保存!"
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -