📄 y
字号:
Picture = "y因素趋势分析结果.frx":3A776
Key = "zd"
EndProperty
BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "y因素趋势分析结果.frx":3AB10
Key = "dz"
EndProperty
BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "y因素趋势分析结果.frx":3AEAA
Key = "ph"
EndProperty
BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "y因素趋势分析结果.frx":3B244
Key = "fz"
EndProperty
BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "y因素趋势分析结果.frx":3B5DE
Key = "dw"
EndProperty
BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "y因素趋势分析结果.frx":3B978
Key = "hf"
EndProperty
BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "y因素趋势分析结果.frx":3BD12
Key = "pz"
EndProperty
BeginProperty ListImage32 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "y因素趋势分析结果.frx":3C0AC
Key = "check"
EndProperty
BeginProperty ListImage33 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "y因素趋势分析结果.frx":3C446
Key = "zz"
EndProperty
BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "y因素趋势分析结果.frx":3C7E0
Key = "mx"
EndProperty
BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "y因素趋势分析结果.frx":3CB7A
Key = "lj"
EndProperty
EndProperty
End
End
Begin vsElasticLightLibCtl.vsElasticLight vsElasticLight1
Left = 7380
OleObjectBlob = "y因素趋势分析结果.frx":3CF14
Top = 30
End
End
Attribute VB_Name = "YSFX_FrmQsFx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const strJ = "借方发生额"
Private Const strD = "贷方发生额"
Private Const strJe = "净额"
Private Const strYe = "余额"
Private Const COL_WIDTH = 1650 '网格列宽
Private Const strJF = "借"
Private Const strDF = "贷"
'*********************************************************************
'* 模 块 名 称 :因素趋势分析结果
'* 功 能 描 述 :
'* 程序员姓名 :白石军
'* 最后修改人 :白石军
'* 最后修改时间:
'* 备 注:程序中所有依实际情况自定义部分均用[>> <<]括起
'*
'*
'*********************************************************************
Dim ReportTitle As String '报表主标题
Dim myclsBal As New clsBal '资产负债表类
Dim myclsInc As New clsInc '损益表类
Dim Int_Curr_year As Integer '分析期年
Dim Int_Curr_month1 As Integer '分析期开始月
Dim Int_Curr_month2 As Integer '分析期结束月
Dim SumRs As New ADODB.Recordset '总账记录集
Dim CodeRs As New ADODB.Recordset '科目记录集
'以下为固定使用变量
Dim Dyymctbl As New DY_Dyymsz '打印页面窗体变量
Dim GridCode As String '显示网格网格代码
Dim GridInf() As Variant '整个网格设置信息
Dim Tsxx As String '系统提示信息
Dim Qslz As Long '网格隐藏(非操作显示)列数
Dim Sjhgd As Double '网格数据行高度
Dim Sfxshjwg As Boolean '是否显示合计网格
Dim GridBoolean() As Boolean '网格列信息(布尔型)
Dim GridStr() As String '网格列信息(字符型)
Dim GridInt() As Integer '网格列信息(整型)
Dim Szzls As Integer '数组总列数(网格列数-1)
Private Sub Form_Resize() '根据窗体大小来调整网格,标题栏大小
On Error Resume Next
With CxbbGrid
.Width = Me.Width - 160
.Height = Me.Height - .Top - 400
End With
With Pic_Title
.Width = Me.Width - 160
End With
GsToolbar.Left = Me.Width - GsToolbar.Width - 160
End Sub
Private Sub Form_Load() '窗体装入
'调入打印页面设置窗体
ReportTitle = "因素趋势分析"
XtReportCode = "cwfx_YsqsFx"
Load Dyymctbl
' Me.Caption = "因素趋势分析"
' TsLabel(4).Caption = "科目结构分析表"
'调整标题栏及网格、格式工具条位置
Pic_Title.Left = 40
Pic_Title.Top = SzToolbar.Top + SzToolbar.Height - 10
CxbbGrid.Left = Pic_Title.Left
CxbbGrid.Top = Pic_Title.Top + Pic_Title.Height + 20
'调 入 网 格
GridCode = "cwfx_YsqsFx"
Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
Qslz = GridInf(1)
Sjhgd = GridInf(2)
Sfxshjwg = GridInf(7)
Szzls = CxbbGrid.Cols - 1
myclsBal.Init Cw_DataEnvi.DataConnect
myclsInc.Init Cw_DataEnvi.DataConnect
CodeRs.Open "select * from cwzz_AccCode", Cw_DataEnvi.DataConnect, adOpenDynamic
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体卸载
'卸载条件窗体
YX_FrmAccountDeptC.UnloadCheck.Value = 1
Unload YX_FrmAccountDeptC
'卸载打印页面设置窗体
Unload Dyymctbl
Set myclsBal = Nothing
Set myclsInc = Nothing
CodeRs.Close
Set CodeRs = Nothing
End Sub
Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button) '网格格式调整
Select Case Button.Key
Case "bcgs" '保存表格格式
Call Bcwggs(CxbbGrid, GridCode)
Case "hfmrgs" '恢复默认格式
Call Hfmrgs(CxbbGrid, GridCode)
Case "szxsxm" '设置显示项目
Call Szxsxm(CxbbGrid, GridCode)
End Select
End Sub
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "ymsz" '页面设置
Dyymctbl.Show 1
Case "yl" '预 览
Call bbyl(True)
Case "dy" '打 印
Call bbyl(False)
Case "cx" '查 询
YSFX_FrmQsSeach.Show 1
Case "bz" '帮 助
Call F1bz
Case "fh" '退 出
Unload Me
End Select
End Sub
Private Sub Timer1_Timer() '在窗体激活后调入查询程序
Timer1.Enabled = False
If DEBUG_FLAG = False Then
On Error Resume Next
Xt_Wait.Show
Xt_Wait.Refresh
End If
'加快显示速度
CxbbGrid.Redraw = False
GridCode = "cwfx_YsqsFx"
Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
'生成查询结果
Call Sub_Query
CxbbGrid.Redraw = True
If DEBUG_FLAG = False Then
Xt_Wait.Hide
End If
End Sub
Private Sub Sub_Query() '生成查询结果
Dim Rec_Query As New ADODB.Recordset '查询结果动态集
Dim temRs As New ADODB.Recordset '查询
Dim SqlStr As String '查询动态连接字符串
Dim i As Integer
Dim j As Integer
Dim Str_Ccode As String '科目
Dim Str_AccountType As String '科目方向
Dim dbl_Value As Double '数据
Dim dbl_Total As Double '合计数据
Dim int_Months As Integer '月数
'以下为用户自定义部分[
Int_Curr_year = Xtyear
Int_Curr_month1 = Val(Right(YSFX_FrmQsSeach.Combo_DateBegin.Text, 2))
Int_Curr_month2 = Val(Right(YSFX_FrmQsSeach.Combo_DateEnd.Text, 2))
With YSFX_FrmQsSeach.CxbbGridR
For i = .FixedRows To .Rows - 1
Me.CxbbGrid.AddItem ""
Me.CxbbGrid.RowHeight(i) = Sjhgd
Me.CxbbGrid.TextMatrix(Me.CxbbGrid.Rows - 1, 1) = .TextMatrix(i, 2)
Next
For i = Int_Curr_month1 To Int_Curr_month2
With Me.CxbbGrid
.Cols = .Cols + 1
.ColWidth(.Cols - 1) = COL_WIDTH
.ColAlignment(.Cols - 1) = 6
.FixedAlignment(.Cols - 1) = flexAlignCenterCenter
.ColFormat(.Cols - 1) = "#,##0.00"
.TextMatrix(.FixedRows - 1, .Cols - 1) = Int_Curr_year & "\" & Format(i, "00")
End With
Next
With Me.CxbbGrid
.Cols = .Cols + 1
.ColAlignment(.Cols - 1) = 6
.FixedAlignment(.Cols - 1) = flexAlignCenterCenter
.ColWidth(.Cols - 1) = COL_WIDTH
.ColFormat(.Cols - 1) = "#,##0.00"
.TextMatrix(.FixedRows - 1, .Cols - 1) = "平均值"
End With
int_Months = (Int_Curr_month2 - Int_Curr_month1) + 1 '月数
For i = .FixedRows To .Rows - 1
Str_Ccode = .TextMatrix(i, 1)
Str_AccountType = .TextMatrix(i, 3)
dbl_Total = 0 '合计数据置零
If Str_Ccode = "" Then
Set temRs = Cw_DataEnvi.DataConnect.Execute("select * from Cwfx_Qsfx where cDisplayName='" & .TextMatrix(i, 2) & "'")
If Not temRs.EOF Then
For j = Sydz("001", GridStr(), Szzls) + 1 To Me.CxbbGrid.Cols - 2
If Trim(temRs!cTableName) = "cwfx_BalanceInitial" Then
dbl_Value = myclsBal.GetPeriodValue(Trim(temRs!cItemName), Val(Right(Me.CxbbGrid.TextMatrix(0, j), 2)), Int_Curr_year)
ElseIf Trim(temRs!cTableName) = "cwfx_IncomeCostInitial" Then
dbl_Value = myclsInc.GetPeriodValue(Trim(temRs!cItemName), Val(Right(Me.CxbbGrid.TextMatrix(0, j), 2)), Int_Curr_month2, Int_Curr_year)
End If
dbl_Total = dbl_Total + dbl_Value
Me.CxbbGrid.TextMatrix(i, j) = IIf(dbl_Value = 0, "", dbl_Value)
Next
Me.CxbbGrid.TextMatrix(i, j) = IIf(dbl_Total = 0, "", dbl_Total / int_Months)
End If
Else
For j = Sydz("001", GridStr(), Szzls) + 1 To Me.CxbbGrid.Cols - 2
SqlStr = "select * from Cwzz_AccSum where ccode='" & Str_Ccode & "' and Year=" & Int_Curr_year & " and Period=" & Val(Right(Me.CxbbGrid.TextMatrix(0, j), 2))
Set SumRs = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Not (SumRs.EOF And SumRs.BOF) Then
CodeRs.MoveFirst
CodeRs.Find "cCode='" & Str_Ccode & "'"
If Not CodeRs.EOF Then
Select Case Str_AccountType
Case strJ
dbl_Value = SumRs!Mjje
Case strD
dbl_Value = SumRs!Mdje
Case strJe
'--------------------------
If Trim(CodeRs!BalanceOri) = "借" Then
dbl_Value = SumRs!Mjje - SumRs!Mdje
Else
dbl_Value = SumRs!Mdje - SumRs!Mjje
End If
'---------------------------------
Case strYe
dbl_Value = SumRs!qmye
End Select
End If
End If
dbl_Total = dbl_Total + dbl_Value
Me.CxbbGrid.TextMatrix(i, j) = IIf(dbl_Value = 0, "", dbl_Value)
Next
If int_Months = 0 Then
Me.CxbbGrid.TextMatrix(i, j) = ""
Else
Me.CxbbGrid.TextMatrix(i, j) = IIf(dbl_Total = 0, "", dbl_Total / int_Months)
End If
End If
Next
End With
End Sub
Private Function FormatValue(ByVal dbl_PastVal, ByVal intValType As Integer) As Double
'格式化数值
Dim dbl_Value As Double
Select Case intValType
End Select
FormatValue = dbl_Value
End Function
Private Sub bbyl(bbylte As Boolean) '报表打印预览
Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
Bbxbtgs = 1 '报 表 小 标 题 行 数
Bbbwhgs = 0 '报 表 表 尾 行 数
ReDim Bbxbt(1 To Bbxbtgs)
ReDim bbxbtzzxs(1 To Bbxbtgs)
If Bbbwhgs <> 0 Then
ReDim Bbbwh(1 To Bbbwhgs)
ReDim Bbbwhzzxs(1 To Bbbwhgs)
End If
Bbzbt = ReportTitle
Bbxbt(1) = Space(2) & Lab_TitleText(0).Caption
bbxbtzzxs(1) = 0 '报表行组织形式(0-居左 1-居中 2-居右)
Call Scyxsjb(CxbbGrid) '生成报表数据
Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
If Not bbylte Then
Unload DY_Tybbyldy
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -