📄 frmyfhzdata.frm
字号:
VERSION 5.00
Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "Vsflex7.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmYfHzData
Caption = "应付汇总表"
ClientHeight = 6105
ClientLeft = 240
ClientTop = 2220
ClientWidth = 9555
LinkTopic = "Form2"
ScaleHeight = 6105
ScaleWidth = 9555
Begin VSFlex7Ctl.VSFlexGrid Flex
Height = 5085
Index = 0
Left = 60
TabIndex = 0
Tag = "N"
Top = 630
Width = 9435
_cx = 16642
_cy = 8969
_ConvInfo = 1
Appearance = 1
BorderStyle = 1
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MousePointer = 0
BackColor = -2147483643
ForeColor = -2147483640
BackColorFixed = -2147483633
ForeColorFixed = -2147483630
BackColorSel = -2147483635
ForeColorSel = -2147483634
BackColorBkg = -2147483636
BackColorAlternate= -2147483643
GridColor = -2147483633
GridColorFixed = -2147483632
TreeColor = -2147483632
FloodColor = 192
SheetBorder = -2147483642
FocusRect = 1
HighLight = 1
AllowSelection = -1 'True
AllowBigSelection= -1 'True
AllowUserResizing= 1
SelectionMode = 0
GridLines = 1
GridLinesFixed = 2
GridLineWidth = 1
Rows = 2
Cols = 2
FixedRows = 1
FixedCols = 1
RowHeightMin = 0
RowHeightMax = 0
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = ""
ScrollTrack = 0 'False
ScrollBars = 3
ScrollTips = 0 'False
MergeCells = 0
MergeCompare = 0
AutoResize = -1 'True
AutoSizeMode = 0
AutoSearch = 0
AutoSearchDelay = 2
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 0
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = 0
ShowComboButton = -1 'True
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
DataMember = ""
ComboSearch = 3
AutoSizeMouse = -1 'True
FrozenRows = 0
FrozenCols = 0
AllowUserFreezing= 0
BackColorFrozen = 0
ForeColorFrozen = 0
WallPaperAlignment= 9
End
Begin MSComctlLib.StatusBar SBar
Align = 2 'Align Bottom
Height = 315
Index = 0
Left = 0
TabIndex = 1
Top = 5790
Width = 9555
_ExtentX = 16854
_ExtentY = 556
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Tlbaction
Align = 1 'Align Top
Height = 570
Index = 0
Left = 0
TabIndex = 2
Top = 0
Width = 9555
_ExtentX = 16854
_ExtentY = 1005
ButtonWidth = 609
ButtonHeight = 953
Style = 1
_Version = 393216
BorderStyle = 1
End
Begin MSComctlLib.ImageList Img
Index = 0
Left = 0
Top = 330
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
MaskColor = 12632256
_Version = 393216
End
Begin VB.Menu mFile
Caption = "文件(&F)"
Begin VB.Menu muFile
Caption = ""
Index = 0
End
End
Begin VB.Menu mEdit
Caption = "编辑(&E)"
Begin VB.Menu muEdit
Caption = ""
Index = 0
End
End
Begin VB.Menu mView
Caption = "查看(&V)"
Begin VB.Menu muView
Caption = ""
Index = 0
End
End
Begin VB.Menu mHelp
Caption = "帮助(&H)"
Begin VB.Menu muHelp
Caption = ""
Index = 0
End
End
End
Attribute VB_Name = "frmYfHzData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const TlbRfdData = 0
Const ImgRfdData = 0
Const SBarRfdData = 0
Const FlexRfdData = 0
Dim m_PrintRs As ADODB.Recordset
Dim m_SqlStr As String
Const CmdOk = 0
Const CmdExit = 1
Const LblDesc = 0
Dim oApp As CRAXDDRT.Application
Dim oRpt As CRAXDDRT.Report
Dim oRfd As Rfd
Public Property Set Rfd(vRfd As Rfd)
Set oRfd = vRfd
Me.Caption = oRfd.RfdMc
End Property
Public Property Get Rfd() As Rfd
Set Rfd = oRfd
End Property
Public Property Let SqlStr(vSqlStr As String)
m_SqlStr = vSqlStr
End Property
Private Sub Flex_DblClick(Index As Integer)
Dim mfrmYfMxData As frmYfMxData
Dim mFound As Boolean
Dim mForm As Form
Dim m_KhRs As DbRs
Dim mRfd As Rfd
On Error GoTo Errorhandle
If Flex(Index).Rows = 1 Then
Exit Sub
End If
mFound = False
For Each mForm In Forms
If UCase(mForm.Name) = "frmYfMxData" Then
mFound = True
Set mfrmYfMxData = mForm
Exit For
End If
Next
If mFound = False Then
Set mfrmYfMxData = New frmYfMxData
End If
Set m_KhRs = New DbRs
m_KhRs.FillbyDb "SELECT KHCODE,KHMC FROM KHREC WHERE KHCODE='" & Trim(Flex(Index).TextMatrix(Flex(Index).Row, 2)) & "'"
m_KhRs.MoveFirst
Set mRfd = New Rfd
mRfd.Requery UCase("PRINT_FRMYFMXQUERY")
Set mfrmYfMxData.Rfd = mRfd
Set mfrmYfMxData.KhRs = m_KhRs
mfrmYfMxData.BegCwQjCode = Trim(Flex(Index).TextMatrix(Flex(Index).Row, 1))
mfrmYfMxData.EndCwQjCode = Trim(Flex(Index).TextMatrix(Flex(Index).Row, 1))
mfrmYfMxData.FormatFlexTitle
mfrmYfMxData.LoadDataIntoGrid
mfrmYfMxData.Show
Set m_KhRs = Nothing
Set mRfd = Nothing
Exit Sub
Errorhandle:
Set m_KhRs = Nothing
Set mRfd = Nothing
MsgBox Err.Description
End Sub
Private Sub Flex_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo Errorhandle
gPublicFunction.FlexKeyDown Flex(Index), KeyCode
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Form_Activate()
On Error GoTo Errorhandle
Me.WindowState = 2
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
On Error GoTo Errorhandle
gPublicFunction.LoadFormSet Me, Tlbaction(TlbRfdData), Img(ImgRfdData), SBar(SBarRfdData)
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Public Sub FormatFlexTitle()
Dim mRfdf As Rfdf
Dim mItemStr As String
On Error GoTo Errorhandle
Flex(FlexRfdData).Rows = 1
Flex(FlexRfdData).Cols = 1
Flex(FlexRfdData).FormatString = "|<财务期间|<供应商编码|<供应商名称|<期初应付款|>本期应付发生|>本期付款发生|>期末应付款"
gPublicFunction.GetFlexColWidth Me, Flex(FlexRfdData), gPublicCommon.PublicSysDatas("SYSPATH").SysDataValue & "\FLEXINI.INI", UCase(Me.Name + oRfd.RfdCode)
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Public Sub LoadDataIntoGrid()
Dim mRfdf As Rfdf
Dim mItemStr As String
On Error GoTo Errorhandle
Flex(FlexRfdData).Rows = 1
Set m_PrintRs = gDbCommon.Conn.Execute(m_SqlStr)
If Not m_PrintRs Is Nothing Then
Do While Not m_PrintRs.EOF
mItemStr = vbTab & m_PrintRs("YSYFJCM_CWQJCODE") & vbTab & m_PrintRs("YSYFJCM_KHCODE") & vbTab & m_PrintRs("YSYFJCM_KHMC") & vbTab & m_PrintRs("YSYFJCMAPLAMT") & vbTab & m_PrintRs("YSYFJCMAPIAMT") & vbTab & m_PrintRs("YSYFJCMAPFAMT") & vbTab & m_PrintRs("YSYFJCMAPAMT")
Flex(FlexRfdData).AddItem mItemStr
m_PrintRs.MoveNext
Loop
End If
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub Form_Resize()
On Error GoTo Errorhandle
gPublicCommon.PublicFunction.ResizeForm Me
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Errorhandle
Set m_PrintRs = Nothing
gPublicFunction.SaveFormSet Me
gPublicFunction.SaveFlexColWidth Me, Flex(FlexRfdData), gPublicCommon.PublicSysDatas("SYSPATH").SysDataValue & "\FLEXINI.INI", UCase(Me.Name + oRfd.RfdCode)
Set oRfd = Nothing
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub Tlbaction_ButtonClick(Index As Integer, ByVal Button As MSComctlLib.Button)
Dim Action, RecordName As String
On Error GoTo Errorhandle
Action = (Mid(Button.Key, 1, 3))
RecordName = Button.Key
Select Case Action
Case "OUT"
SaveRecord
Case "PRN"
RfdPrint
Case "EXI"
Unload Me
End Select
Exit Sub
Errorhandle:
MsgBox Err.Description
End Sub
Private Sub SaveRecord()
On Error GoTo Errorhandle
Exit Sub
Errorhandle:
Err.Raise vbObjectError + 1, , Err.Description
End Sub
Private Sub RfdPrint()
Dim mRfdPrint As frmRfdPrint
Dim I As Integer
On Error GoTo Errorhandle
If oRfd.RfdPFile = "" Then
Err.Raise vbObjectError + 1, , "报表未定义打印格式文件，不能打印！"
Exit Sub
End If
m_PrintRs.MoveFirst
If m_PrintRs.EOF Then
Err.Raise vbObjectError + 1, , "报表无输出数据，不能打印！"
Exit Sub
End If
Me.MousePointer = vbHourglass
Set oApp = New CRAXDDRT.Application
Set oRpt = oApp.OpenReport(gPublicCommon.PublicSysDatas("SYSREPORTPATH").SysDataValue & "\" & oRfd.RfdPFile)
oRpt.Database.SetDataSource m_PrintRs
Set mRfdPrint = New frmRfdPrint
mRfdPrint.RfdMc = oRfd.RfdMc
Set mRfdPrint.Rpt = oRpt
Me.MousePointer = vbDefault
mRfdPrint.Show vbModal
Set mRfdPrint = Nothing
Set oRpt = Nothing
Set oApp = Nothing
Exit Sub
Errorhandle:
Set mRfdPrint = Nothing
Set oRpt = Nothing
Set oApp = Nothing
Err.Raise vbObjectError + 1, , Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -