frmzcsy.frm

广翔税务代理版打印,能制作非常复杂的报表.

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()
'读出数据
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
'校对数据库是否已经存在该企业年初数
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("该企业年初数已经存在!覆盖吗?", 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 "您已经成功保存企业" & frmqy.qybm & "年初数", vbOKOnly + vbCritical, "成功保存!"

End Sub