📄 gongsyb.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form gongsyb
BorderStyle = 3 'Fixed Dialog
Caption = "工业企业会计报表（损益表）"
ClientHeight = 5535
ClientLeft = 1020
ClientTop = 1470
ClientWidth = 8490
ControlBox = 0 'False
Icon = "gongsyb.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5535
ScaleWidth = 8490
ShowInTaskbar = 0 'False
Begin VB.CommandButton Command3
Caption = "保存累计数"
Height = 375
Left = 4050
TabIndex = 10
Top = 5055
Width = 1335
End
Begin VB.TextBox Text5
Height = 300
Left = 1530
TabIndex = 9
Text = "Text5"
Top = 390
Width = 3495
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 300
Left = 5940
TabIndex = 8
Top = 375
Width = 1335
_ExtentX = 2355
_ExtentY = 529
_Version = 393216
Format = 23658497
UpDown = -1 'True
CurrentDate = 37216
End
Begin VB.TextBox Text1
BeginProperty DataFormat
Type = 1
Format = "0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 1
EndProperty
Height = 300
IMEMode = 2 'OFF
Left = 90
TabIndex = 7
Text = "Text1"
Top = -165
Visible = 0 'False
Width = 660
End
Begin VB.CommandButton Command2
Caption = "返回(&C)"
Height = 375
Left = 6690
TabIndex = 6
Top = 5055
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "打印(&P)"
Height = 375
Left = 5430
TabIndex = 5
Top = 5055
Width = 1215
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 4155
Left = 375
TabIndex = 0
Top = 795
Width = 7815
_ExtentX = 13785
_ExtentY = 7329
_Version = 393216
Rows = 18
Cols = 4
FixedCols = 2
TextStyleFixed = 3
ScrollBars = 2
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "单位：元"
Height = 180
Left = 7500
TabIndex = 4
Top = 390
Width = 720
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "工会02表"
Height = 180
Left = 7500
TabIndex = 3
Top = 150
Width = 720
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "日期："
Height = 180
Left = 5340
TabIndex = 2
Top = 435
Width = 540
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "编制单位："
Height = 180
Left = 570
TabIndex = 1
Top = 450
Width = 900
End
End
Attribute VB_Name = "gongsyb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const ASC_ENTER = 13 '回车
Dim gRow As Integer
Dim gCol As Integer
Dim zsbexcel As Excel.Application
Dim Col3(30) As Variant
Private Sub Command1_Click()
'On Error GoTo errorhandler
Dim t As Integer
Dim j As Integer
Set zsbexcel = New Excel.Application
zsbexcel.Visible = True
' Set zsbexcel = Nothing
zsbexcel.SheetsInNewWorkbook = 1
Set zsbworkbook = zsbexcel.Workbooks.Open(App.Path + "\" + "sheet\gong02.xlt")
With zsbexcel.ActiveSheet
.Range("C4").Value = Text5
.Range("F5").Value = DTPicker1.Year 'Format(DTPicker1.Value) 'Year + "-" + DTPicker1.Month + "-" + DTPicker1.Day
.Range("H5").Value = DTPicker1.Month
'.Range("C27").Value = Text2
'.Range("K27").Value = Text3
'.Range("C28").Value = Text4
'.Range("K30").Value = DTPicker2
For t = 8 To 24
Grid1.Row = t - 7
'For j = 2 To 3
Grid1.Col = 2
a = "E" + CStr(t)
'If IsNull(Grid1.Text) = False Then
.Range(a) = Grid1.Text
'End If
'Next j
Next t
For j = 8 To 24
Grid1.Row = j - 7
'For j = 2 To 3
Grid1.Col = 3
b = "J" + CStr(j)
.Range(b) = Grid1.Text
'If IsNull(Grid1.Text) = False Then
'End If
'Next j
Next j
End With
'dd = MsgBox("yes or no", vbYesNo + vbSystemModal)
'If dd = vbNo Then Exit Sub
' zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait 'xlLandscape
'zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
zsbexcel.Caption = "打印预览"
zsbexcel.ActiveWindow.SelectedSheets.PrintPreview
'zsbexcel.ActiveSheet.PrintOut
zsbexcel.DisplayAlerts = False
zsbexcel.Quit
zsbexcel.DisplayAlerts = True
Set zsbexcel = Nothing
Exit Sub
'errorhandler:
'MsgBox "请正确安装EXCEL！", vbOKOnly + vbCritical
'Exit Sub
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
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("gongleijishu", dbOpenTable)
Set EF = db.OpenRecordset("Select * From gongleijishu 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 gongleijishu where qybm='" & frmqy.qybm & "'"
db.Close
DBEngine.CommitTrans
'保存记录
'保存Grid1
For i = 1 To Grid1.Rows
Grid1.Col = 3
Grid1.Row = i
ShangValue = Grid1.Text
DBEngine.BeginTrans
Set db = OpenDatabase(Con, False, False, ConStr)
RecStr = "Insert into gongleijishu (leijishu,qybm) values('" & Trim(ShangValue) & "','" & Trim(frmqy.qybm) & "')"
db.Execute RecStr
db.Close
DBEngine.CommitTrans
Next i
MsgBox "您已经成功保存企业" & frmqy.qybm & "累计数", vbOKOnly + vbCritical, "成功保存!"
End Sub
Private Sub Form_Load()
DTPicker1 = Date
Text5 = frmqy.qymc
'Text2 = frmqy.qyfrxm
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
Grid1.TextStyleFixed = flexTextFlat
Grid1.ColWidth(0) = (Grid1.Width / 4) + 1200
Grid1.ColWidth(1) = (Grid1.Width / 4) - 1200
Grid1.ColWidth(2) = (Grid1.Width / 4) - 50
Grid1.ColWidth(3) = (Grid1.Width / 4) - 50
For i = 1 To 17
Grid1.TextMatrix(i, 2) = "0.00"
Grid1.TextMatrix(i, 3) = "0.00"
Next i
Grid1.TextMatrix(0, 0) = " 项 目"
Grid1.TextMatrix(0, 1) = " 行数"
Grid1.TextMatrix(0, 2) = " 本月数"
Grid1.TextMatrix(0, 3) = " 本年累计数"
Grid1.TextMatrix(1, 0) = "一、产品销售收入"
Grid1.TextMatrix(1, 1) = " 1"
Grid1.TextMatrix(2, 0) = " 减：产品销售成本"
Grid1.TextMatrix(2, 1) = " 2"
Grid1.TextMatrix(3, 0) = " 产品销售费用"
Grid1.TextMatrix(3, 1) = " 3"
Grid1.TextMatrix(4, 0) = " 产品销售税金及附加"
Grid1.TextMatrix(4, 1) = " 4"
Grid1.TextMatrix(5, 0) = "二、产品销售利润"
Grid1.TextMatrix(5, 1) = " 7"
Grid1.TextMatrix(6, 0) = " 加：其他业务利润"
Grid1.TextMatrix(6, 1) = " 9"
Grid1.TextMatrix(7, 0) = " 减：管理费用"
Grid1.TextMatrix(7, 1) = " 10"
Grid1.TextMatrix(8, 0) = " 财务费用"
Grid1.TextMatrix(8, 1) = " 11"
Grid1.TextMatrix(9, 0) = "三、营业利润"
Grid1.TextMatrix(9, 1) = " 14"
Grid1.TextMatrix(10, 0) = " 加：投资收益"
Grid1.TextMatrix(10, 1) = " 15"
Grid1.TextMatrix(11, 0) = " 补贴收入"
Grid1.TextMatrix(11, 1) = " 16"
Grid1.TextMatrix(12, 0) = " 营业外收入"
Grid1.TextMatrix(12, 1) = " 17"
Grid1.TextMatrix(13, 0) = " 减：营业外支出"
Grid1.TextMatrix(13, 1) = " 18"
Grid1.TextMatrix(14, 0) = " 加：以前年度损益调整"
Grid1.TextMatrix(14, 1) = " 20"
Grid1.TextMatrix(15, 0) = "四、利润总额"
Grid1.TextMatrix(15, 1) = " 25"
Grid1.TextMatrix(16, 0) = " 减：所得税"
Grid1.TextMatrix(16, 1) = " 26"
Grid1.TextMatrix(17, 0) = "五、净利润"
Grid1.TextMatrix(17, 1) = " 30"
Grid1.Row = 5
Grid1.Col = 2
'Grid1.CellForeColor = vbRed
Grid1.CellBackColor = &HE0E0E0
Grid1.Row = 5
Grid1.Col = 3
'Grid1.CellForeColor = vbRed
Grid1.CellBackColor = &HE0E0E0
Grid1.Row = 9
Grid1.Col = 2
'Grid1.CellForeColor = vbRed
Grid1.CellBackColor = &HE0E0E0
Grid1.Row = 9
Grid1.Col = 3
'Grid1.CellForeColor = vbRed
Grid1.CellBackColor = &HE0E0E0
Grid1.Row = 15
Grid1.Col = 2
'Grid1.CellForeColor = vbRed
Grid1.CellBackColor = &HE0E0E0
Grid1.Row = 15
Grid1.Col = 3
'Grid1.CellForeColor = vbRed
Grid1.CellBackColor = &HE0E0E0
Grid1.Row = 17
Grid1.Col = 2
'Grid1.CellForeColor = vbRed
Grid1.CellBackColor = &HE0E0E0
Grid1.Row = 17
Grid1.Col = 3
'Grid1.CellForeColor = vbRed
Grid1.CellBackColor = &HE0E0E0
LoadLeiJi
End Sub
Private Sub Grid1_DblClick()
' Move the text box to the current grid cell:
Text1.Top = Grid1.CellTop + Grid1.Top
Text1.Left = Grid1.CellLeft + Grid1.Left
' Save the position of the grids Row and Col for later:
gRow = Grid1.Row
gCol = Grid1.Col
If gRow = 5 And gCol = 2 Then Exit Sub
If gRow = 5 And gCol = 3 Then Exit Sub
If gRow = 9 And gCol = 2 Then Exit Sub
If gRow = 9 And gCol = 3 Then Exit Sub
If gRow = 15 And gCol = 2 Then Exit Sub
If gRow = 15 And gCol = 3 Then Exit Sub
If gRow = 17 And gCol = 2 Then Exit Sub
If gRow = 17 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 Grid1_KeyPress(KeyAscii As Integer)
Call Grid1_DblClick
End Sub
Private Sub Label2_Click()
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()
On Error GoTo errorhandler
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(Val(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(5, 2) = Format(Val(Grid1.TextMatrix(1, 2)) - Val(Grid1.TextMatrix(2, 2)) - Val(Grid1.TextMatrix(3, 2)) - Val(Grid1.TextMatrix(4, 2)), "###0.00")
Grid1.TextMatrix(5, 3) = Format(Val(Grid1.TextMatrix(1, 3)) - Val(Grid1.TextMatrix(2, 3)) - Val(Grid1.TextMatrix(3, 3)) - Val(Grid1.TextMatrix(4, 3)), "###0.00")
Grid1.TextMatrix(9, 2) = Format(Val(Grid1.TextMatrix(5, 2)) + Val(Grid1.TextMatrix(6, 2)) - Val(Grid1.TextMatrix(7, 2)) - Val(Grid1.TextMatrix(8, 2)), "###0.00")
Grid1.TextMatrix(9, 3) = Format(Val(Grid1.TextMatrix(5, 3)) + Val(Grid1.TextMatrix(6, 3)) - Val(Grid1.TextMatrix(7, 3)) - Val(Grid1.TextMatrix(8, 3)), "###0.00")
Grid1.TextMatrix(15, 2) = Format(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)), "###0.00")
Grid1.TextMatrix(15, 3) = Format(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)), "###0.00")
Grid1.TextMatrix(17, 2) = Format(Val(Grid1.TextMatrix(15, 2)) - Val(Grid1.TextMatrix(16, 2)), "###0.00")
Grid1.TextMatrix(17, 3) = Format(Val(Grid1.TextMatrix(15, 3)) - Val(Grid1.TextMatrix(16, 3)), "###0.00")
If Grid1.Col = 2 Then
'计算累计数
For i = 1 To Grid1.Rows
Grid1.Row = i
Grid1.Col = 2
Col2 = Grid1.Text
Grid1.Col = 3
Grid1.Text = Format(Val(Col2) + Val(Col3(i)), "###0.00")
Next i
Else
End If
Exit Sub
errorhandler:
Exit Sub
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub
Private Sub LoadLeiJi()
'读出数据
On Error Resume Next
Dim db As Database, EF As Recordset
Set db = OpenDatabase(Con, False, False, ConStr)
Set EF = db.OpenRecordset("gongleijishu", dbOpenTable)
Set EF = db.OpenRecordset("Select * From gongleijishu where qybm='" & frmqy.qybm & "'" & "Order BY ID", dbOpenDynaset)
i = 1
Do While Not EF.EOF
Grid1.Col = 3
Grid1.Row = i
Col3(i) = EF.Fields("leijishu").Value
Grid1.Text = Col3(i)
EF.MoveNext
i = i + 1
Loop
EF.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -