企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Balance_KF_HandBalance 
   Caption         =   "手工结算"
   ClientHeight    =   6315
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10080
   HelpContextID   =   1215002
   Icon            =   "结算_手工结算.frx":0000
   LinkTopic       =   "Form3"
   ScaleHeight     =   6315
   ScaleWidth      =   10080
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   4500
      Top             =   570
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   3510
      Top             =   540
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      ItemData        =   "结算_手工结算.frx":1042
      Left            =   7785
      List            =   "结算_手工结算.frx":1044
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   585
      Width           =   2235
   End
   Begin VB.CommandButton ydcommand 
      Height          =   300
      Left            =   1287
      Picture         =   "结算_手工结算.frx":1046
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   4379
      Visible         =   0   'False
      Width           =   300
   End
   Begin VB.TextBox Ydtext 
      BackColor       =   &H80000018&
      BorderStyle     =   0  'None
      Height          =   309
      Left            =   1671
      MultiLine       =   -1  'True
      TabIndex        =   3
      Top             =   3795
      Visible         =   0   'False
      Width           =   1200
   End
   Begin VB.ComboBox YdCombo 
      Height          =   300
      Left            =   2904
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   3795
      Visible         =   0   'False
      Width           =   1170
   End
   Begin VB.OptionButton Option1 
      Caption         =   "按数量分摊"
      Height          =   239
      Left            =   7320
      TabIndex        =   1
      Top             =   3915
      Width           =   1229
   End
   Begin VB.OptionButton Option2 
      Caption         =   "按金额分摊"
      Height          =   240
      Left            =   8760
      TabIndex        =   0
      Top             =   3915
      Width           =   1229
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   2400
      Top             =   390
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   11
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":13D0
            Key             =   "sz"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":176A
            Key             =   "dy"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":1B04
            Key             =   "yl"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":1E9E
            Key             =   "gl"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":2238
            Key             =   "rkd"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":25D2
            Key             =   "fp"
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":296C
            Key             =   "fyd"
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":2D06
            Key             =   "fyp"
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":30A0
            Key             =   "js"
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":343A
            Key             =   "bz"
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "结算_手工结算.frx":37D4
            Key             =   "tc"
         EndProperty
      EndProperty
   End
   Begin VSFlex8Ctl.VSFlexGrid BanlGrid1 
      Height          =   2865
      Left            =   75
      TabIndex        =   6
      Top             =   915
      Width           =   9945
      _cx             =   5080
      _cy             =   5080
      Appearance      =   1
      BorderStyle     =   1
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         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    =   -2147483643
      ForeColorSel    =   -2147483641
      BackColorBkg    =   8421504
      BackColorAlternate=   -2147483643
      GridColor       =   -2147483633
      GridColorFixed  =   -2147483632
      TreeColor       =   -2147483632
      FloodColor      =   192
      SheetBorder     =   -2147483642
      FocusRect       =   1
      HighLight       =   1
      AllowSelection  =   -1  'True
      AllowBigSelection=   -1  'True
      AllowUserResizing=   0
      SelectionMode   =   0
      GridLines       =   1
      GridLinesFixed  =   2
      GridLineWidth   =   1
      Rows            =   5000
      Cols            =   10
      FixedRows       =   1
      FixedCols       =   0
      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=   0
      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
      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
      AccessibleName  =   ""
      AccessibleDescription=   ""
      AccessibleValue =   ""
      AccessibleRole  =   24
   End
   Begin VSFlex8Ctl.VSFlexGrid BanlGrid2 
      Height          =   2010
      Left            =   75
      TabIndex        =   7
      Top             =   4200
      Width           =   9945
      _cx             =   5080
      _cy             =   5080
      Appearance      =   1
      BorderStyle     =   1
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         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    =   -2147483643
      ForeColorSel    =   -2147483640
      BackColorBkg    =   8421504
      BackColorAlternate=   -2147483643
      GridColor       =   -2147483633
      GridColorFixed  =   -2147483632
      TreeColor       =   -2147483632
      FloodColor      =   192
      SheetBorder     =   -2147483642
      FocusRect       =   1
      HighLight       =   1
      AllowSelection  =   -1  'True
      AllowBigSelection=   -1  'True
      AllowUserResizing=   0
      SelectionMode   =   0
      GridLines       =   1
      GridLinesFixed  =   2
      GridLineWidth   =   1
      Rows            =   5000
      Cols            =   10
      FixedRows       =   1
      FixedCols       =   0
      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
      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
      AccessibleName  =   ""
      AccessibleDescription=   ""
      AccessibleValue =   ""
      AccessibleRole  =   24
   End
   Begin MSComctlLib.Toolbar SzToolbar1 
      Align           =   1  'Align Top
      Height          =   555
      Left            =   0
      TabIndex        =   8
      Top             =   0
      Width           =   10080
      _ExtentX        =   17780
      _ExtentY        =   979
      ButtonWidth     =   1138
      ButtonHeight    =   926
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   11
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "设置"
            Key             =   "ymsz"
            Object.ToolTipText     =   "打印页面设置"
            ImageKey        =   "sz"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "打印"
            Key             =   "dy"
            ImageKey        =   "dy"
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "预览"
            Key             =   "yl"
            ImageKey        =   "yl"
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "过滤"
            Key             =   "gl"
            ImageKey        =   "gl"
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "入库单"
            Key             =   "rkd"
            Object.ToolTipText     =   "选择入库单"
            ImageKey        =   "rkd"
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "发票"
            Key             =   "fp"
            Object.ToolTipText     =   "选择发票"
            ImageKey        =   "fp"
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "结算"
            Key             =   "js"
            Object.ToolTipText     =   "结算"
            ImageKey        =   "js"
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "帮助"
            Key             =   "bz"
            ImageKey        =   "bz"
         EndProperty
         BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "fh"
            ImageKey        =   "tc"
         EndProperty
      EndProperty
      BorderStyle     =   1
      Begin MSComctlLib.ProgressBar ProgressBar1 
         Height          =   105
         Left            =   6390
         TabIndex        =   14
         Top             =   270
         Visible         =   0   'False
         Width           =   3435
         _ExtentX        =   6059
         _ExtentY        =   185
         _Version        =   393216
         Appearance      =   0
         Max             =   2000
      End
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "结算类型:"
      Height          =   180
      Left            =   6960
      TabIndex        =   13
      Top             =   645
      Width           =   810
   End
   Begin VB.Label Lab_Row 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      ForeColor       =   &H00FF0000&
      Height          =   211
      Left            =   72
      TabIndex        =   12
      Top             =   0
      Width           =   319
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "结算汇总:"
      Height          =   180
      Left            =   135
      TabIndex        =   11
      Top             =   645
      Width           =   810
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "结算费用汇总:"
      Height          =   180
      Left            =   105
      TabIndex        =   10
      Top             =   3945
      Width           =   1170
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "费用分摊方式:"
      Height          =   180
      Left            =   6000
      TabIndex        =   9
      Top             =   3945
      Width           =   1170
   End
End
Attribute VB_Name = "Balance_KF_HandBalance"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************************************************
'*    模 块 名 称 :手工结算
'*    功 能 描 述 :
'*    程序员姓名  :周化江
'*    最后修改人  :周化江
'*    最后修改时间:2001/10/16
'*    备        注:程序中所有依实际情况自定义部分均用[>> <<]括起
'*
'*    1.每次调入外部功能窗体，均要加锁ChangeLock=True,窗体关闭后解锁ChangeLock=false
'*
'*    3.Lab_OperStatus 用此标签来标识单据录入状态(默认值为1) 1-浏览 2-修改
'*
'***************************************************************************************
 
'以下为自定义变量
 
'其它固定使用变量
Dim Tsxx As String                              '系统信息提示(Fixed)
Dim ReportTitle As String                       '报表主标题(Fixed)
   
'以下为固定使用变量(网格)
Dim Cxnrrec As New ADODB.Recordset              '显示查询内容动态集
Dim Dyymctbl As New DY_Dyymsz                   '打印页面窗体变量
Dim GridCode As String                          '显示网格网格代码
Dim GridInf() As Variant                        '整个网格设置信息
Dim Pmbcsjhs As Long                            '屏幕网格保持数据行数(大于等于1)
Dim Fzxwghs As Integer                          '辅助项网格行数(包括合计行)
Dim Sfxshjwg As Boolean                         '是否显示合计网格
Dim Qslz As Long                                '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                             '网格数据行高度
Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
Dim GridStr()  As String                        '网格列信息(字符型)
Dim GridInt() As Integer                        '网格列信息(整型)
Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
Dim Dqlrwgh As Long                             '当前录入数据网格行
Dim Dqlrwgl As Long                             '当前录入数据网格列
Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
Dim Dqlkwgl As Long                             '刚刚离开网格列
Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
Dim Wbkbhlock As Boolean                        '文本框改变值锁
Dim Changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
Dim Shsfts As Boolean                           '删除记录行是否提示
Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
'''''''''''''''''''''''
'以下为固定使用变量
Dim GridCode1 As String                   '显示网格网格代码
Dim GridInf1() As Variant                 '整个网格设置信息
Dim Qslz1 As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd1 As Double                      '网格数据行高度
Dim Sfxshjwg1 As Boolean                  '是否显示合计网格
Dim GridBoolean1() As Boolean             '网格列信息(布尔型)
Dim GridStr1()  As String                 '网格列信息(字符型)
Dim GridInt1() As Integer                 '网格列信息(整型)
Dim Szzls1 As Integer                     '数组总列数(网格列数-1)
''''''''''''''自定义
Dim gridlock As Boolean
Dim Bln_ClrkdKfsc As Boolean
Dim FilterInvoice As String              '发票条件
Dim FilterInOut As String                '入库单中是否存在符合的记录
Dim Collect_BalanceRelation() As New Collection
Dim str_InvoiceFilterCondition As String
Dim str_InOutFilterCondition As String
Dim str_InOutFilterConditionOther As String
Private Sub BanlGrid1_AfterEdit(ByVal Row As Long, ByVal Col As Long)
    With BanlGrid1
        If .ValueMatrix(.Row, 1) = 0 Or .IsSubtotal(.Row) Then
            Exit Sub
        End If
        Select Case .Col
            Case Sydz("013", GridStr1(), Szzls1)
                If .ValueMatrix(.Row, .Col) = 0 Then
                    .TextMatrix(.Row, .Col) = ""
                End If
                Call SubTotal
            Case Sydz("014", GridStr1(), Szzls1)
                If .ValueMatrix(.Row, .Col) = 0 Then
                    .TextMatrix(.Row, .Col) = ""
                End If
                Call SubTotal
            Case Sydz("015", GridStr1(), Szzls1)
                If .ValueMatrix(.Row, .Col) = 0 Then
                    .TextMatrix(.Row, .Col) = ""
                End If
                Call SubTotal
        End Select
    End With
End Sub
Private Sub BanlGrid1_EnterCell()
    With BanlGrid1
        Select Case .Col
            Case Sydz("013", GridStr1(), Szzls1), Sydz("014", GridStr1(), Szzls1), Sydz("015", GridStr1(), Szzls1)     '当发票为负发票时，不允许输入损耗
                If .IsSubtotal(.Row) = False And .ValueMatrix(.Row, 1) = 1 Then
                        gridlock = False
                        BanlGrid1.Editable = True
                Else
                    BanlGrid1.Editable = False
                End If
             Case Else
                gridlock = True
                BanlGrid1.Editable = False
        End Select
    End With
End Sub
Private Sub BanlGrid1_KeyPressEdit(ByVal Row As Long, ByVal Col As Long, KeyAscii As Integer)
    Select Case Col
        Case Sydz("013", GridStr1(), Szzls1), Sydz("015", GridStr1(), Szzls1) '控制合理损耗为有效的数值
            Call check_num_for_grid(BanlGrid1, KeyAscii)
        Case Sydz("014", GridStr1(), Szzls1)      '控制非合理损耗只能为正
            Call check_num_for_grid1(BanlGrid1, KeyAscii)
    End Select
End Sub
Private Sub BanlGrid1_LeaveCell()
    With BanlGrid1
        If .Rows <= 1 Then Exit Sub
        If .ValueMatrix(.Row, 1) = 0 Or .IsSubtotal(.Row) Then
            Exit Sub
        End If
        Select Case .Col
            Case Sydz("013", GridStr1(), Szzls1)
                If .ValueMatrix(.Row, .Col) = 0 Then
                    .TextMatrix(.Row, .Col) = ""
                End If
                Call SubTotal
            Case Sydz("014", GridStr1(), Szzls1)
                If .ValueMatrix(.Row, .Col) = 0 Then
                    .TextMatrix(.Row, .Col) = ""
                End If
                Call SubTotal
            Case Sydz("015", GridStr1(), Szzls1)
                If .ValueMatrix(.Row, .Col) = 0 Then
                    .TextMatrix(.Row, .Col) = ""
                End If
                Call SubTotal
        End Select
    End With
    
End Sub
Private Sub BanlGrid1_LostFocus()
     Call SubTotal
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)      '限制录入字符"'"
    Select Case KeyAscii
        Case 39           '屏蔽字符"'"
            KeyAscii = 0
    End Select
    
End Sub
Private Sub Form_Load()                              '窗 体 装 入
  
    '初始化各种锁值(Fixed)
    Changelock = False             '网格行列改变控制锁
    Gdtlock = False                '滚动条滚动控制
    Yxxpdlock = True               '字段有效性判断锁
    Hyxxpdlock = True              '行有效性判断锁
    Wbkbhlock = False              '文本框内容改变锁
     
    '报表主标题及报表编码(Fixed)
    ReportTitle = "手工结算列表"
    XtReportCode = "KF_HandBalance"
    Load Dyymctbl
    
    GridCode1 = "KF_HandBalanceTop"      '网格属性编码
    Call BzWgcsh(BanlGrid1, GridCode1, GridInf1(), GridBoolean1(), GridInt1(), GridStr1())
    Qslz1 = GridInf1(1)
    Sjhgd1 = GridInf1(2)
    Sfxshjwg1 = GridInf1(7)
    Szzls1 = BanlGrid1.Cols - 1
    '调 入 网 格(Fixed)
    GridCode = "KF_HandBalanceBottom"      '网格属性编码
    Call BzWgcsh(BanlGrid2, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Pmbcsjhs = GridInf(3)
    Fzxwghs = GridInf(4)
    Sfblbzkd = GridInf(5)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = BanlGrid2.Cols - 1
    
    '设置状态为修改状态
    Lab_OperStatus = "2"
    Call FillCombo1(Combo1, "KF_BalanceType", "", 0)
    FilterInvoice = " where 1=1 "
    FilterInOut = " where 1=1 "
    FilterInOut = FilterInOut & " And WhCode in (select whcode from KF_V_WhLimit where ltrim(rtrim(Czybm))='" & Xtczybm & "')"
    Me.InOut_FilterCondition = "  1=2 "
    Me.Invoice_FilterCondition = "  1=2 "
    Bln_ClrkdKfsc = Fun_ClrkdKfsc ''材料入库单是不是由库房生成
End Sub
Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
    '卸载打印页面窗体
    Unload Dyymctbl
    Dim frm_temp As Form
    For Each frm_temp In Forms
       If frm_temp.Name = "Balance_KF_InOut" Then
           Balance_KF_InOut.UnloadCheck = 1
           Unload Balance_KF_InOut
       ElseIf frm_temp.Name = "Balance_KF_Invoice" Then
           Balance_KF_Invoice.UnloadCheck = 1
           Unload Balance_KF_Invoice
       ElseIf frm_temp.Name = "Balance_KF_Query" Then
           Balance_KF_Query.UnloadCheck = 1
           Unload Balance_KF_Query
       End If
    Next frm_temp
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
  
    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
            Case "P"                   'Ctrl+P 打印
                If Tlb_Action.Buttons("dy").Enabled Then
                    Call bbyl(False)
                End If
        End Select
    End If
    
End Sub
Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
 
    Dim xswbrr As String
 
    With BanlGrid2
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
    
        If GridBoolean(.Col, 3) Then   '列表框录入
    
            '填充列表框程序
            Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
        Else
            Wbkbhlock = True
       
            '====以下为用户自定义
            Ydtext.Text = xswbrr
            '====以上为用户自定义
         
            Wbkbhlock = False
            Ydtext.SelStart = Len(Ydtext.Text)
        End If
    End With
    
End Sub
Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long)        '录入数据字段有效性判断,同时进行字段录入事后处理
    
    Dim Str_JudgeText As String            '临时有效性判断字段内容
    Dim Coljsq As Long                     '临时列计数器
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Dbl_Qcye As Double                 '临时期初余额
 
    With BanlGrid2
    
        '非录入状态有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
           sjzdyxxpd = True
           Exit Function
        End If
 
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
        Select Case GridStr(Dqpdwgl, 1)
         
            '以下为自定义部分[
            Case "009"
                If Trim(Str_JudgeText) <> "" Then
                    Sqlstr = "SELECT WhName, WhCode FROM KF_V_WhLimit  WHERE ( WhCode='" & Trim(Str_JudgeText) & "' or WhName='" & Trim(Str_JudgeText) & "') AND (Czybm = '" & Xtczybm & "')"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF Then
                        Tsxx = "此仓库不存在或权限不够!"
                        GoTo Lrcwcl
                    Else
                        .TextMatrix(Dqpdwgh, 4) = Trim("" & RecTemp.Fields("WhCode"))
                        .TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls)) = Trim("" & RecTemp.Fields("WhName"))
                    End If
                Else
                    .TextMatrix(Dqpdwgh, 4) = ""
                    .TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls)) = ""
                End If
            Case "010"
                If Trim(Str_JudgeText) <> "" Then
                    Sqlstr = "SELECT MNumber, MName FROM Gy_Material WHERE (IsCharge = 0) AND (MNumber ='" & Trim(Str_JudgeText) & "' or MName='" & Trim(Str_JudgeText) & "')"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF Then
                        Tsxx = "此物料(实物)不存在!"
                        GoTo Lrcwcl
                    Else
                        .TextMatrix(Dqpdwgh, 5) = Trim("" & RecTemp.Fields("MNumber"))
                        .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = Trim("" & RecTemp.Fields("MName"))
                    End If
                Else
                    .TextMatrix(Dqpdwgh, 5) = ""
                    .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = ""
                End If
            '以上为自定义部分]
        End Select
     
        '字段录入正确后为零字段清空
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
    
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    
    End With
  
Lrcwcl:    '录入错误处理
    With BanlGrid2
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        .Select Dqpdwgh, Dqpdwgl
        Changelock = False
        Call xswbk
        sjzdyxxpd = False
        Exit Function
    End With
    
End Function
Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
 
    Dim Lrywlz As Long                     '录入错误列值(Fixed)
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '临时查询字符串
    Dim Str_Ccode As String                '临时索引编码
    With BanlGrid2
        If Yxxpdh > (.Rows - 1) Then Exit Function
        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
    
        '以下为自定义部分[
    
        '1.1首先进行单个不能为空或不能为零判断(Fixed)
        For jsqte = Qslz To .Cols - 1
            '字段不能为空
            If GridInt(jsqte, 5) = 1 Then
                If Len(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
                    Tsxx = GridStr(jsqte, 2)
                    Lrywlz = jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
            
            '字段不能为零
            If GridInt(jsqte, 5) = 2 Then
                If Val(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0 Then
                    Tsxx = GridStr(jsqte, 2)
                    Lrywlz = jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
        Next jsqte
    
    
        '1.2进行其他有效性判断,编写格式同1.1
                
        '2.放置行处理程序(当数据行通过有效性判断)
           
        Str_Ccode = Trim(.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls)))
           
         
    End With
    '以上为自定义部分]
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
Lrcwcl:      '录入错误处理
    With BanlGrid2
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        .Select Yxxpdh, Lrywlz
        Changelock = False
        Call xswbk
        Sjhzyxxpd = False
        Exit Function
    End With
    
End Function
'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
Private Sub Lrzdbz()                                                      '录入字段帮助
  
    If Not Ydcommand.Visible Then
        Exit Sub
    End If
   
    With BanlGrid2
     
        Valilock = True
    
        '处理通用部分
        Changelock = True        '调入另外窗体必须加锁
        If GridInt(.Col, 6) <> 1 Then
            strHlpR = FunHlpR(Trim(GridStr(.Col, 3)), "czybm", Xtczybm)
        End If
        Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
        strHlpR = ""
        Changelock = False
        
        If Len(Xtfhcs) <> 0 Then
            If GridInt(.Col, 7) = 0 Then
                Ydtext.Text = Xtfhcs
            Else
                Ydtext.Text = Xtfhcsfz
            End If
        End If
        
        Valilock = False
  
        If Ydtext.Visible Then
            Ydtext.SetFocus
        End If
    End With
    
End Sub
Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
   
    Call Cxxswbk
End Sub
Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  
    Fun_Drfrmyxxpd = True
    
    With BanlGrid2
   
        '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  
        If Ydtext.Visible Or YdCombo.Visible Then
            Call Lrsjhx
            If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
                Fun_Drfrmyxxpd = False
                Exit Function
            End If
        End If
   
        '进行行有效性判断
        If Not Sjhzyxxpd(.Row) Then
            Fun_Drfrmyxxpd = False
            Exit Function
        End If
    End With
  
End Function
Private Sub BanlGrid2_EnterCell()                                          '显示当前数据行相关信息
    With BanlGrid2
        If .Row >= .FixedRows Then
            '[>>
                '此处可以填写显示与此网格行相关信息
            '<<]
        End If
    End With
   
End Sub
Private Sub BanlGrid2_GotFocus()                                           '网格得到焦点
    '网格得到焦点,如果当前选择行为非数据行
    '则调整当前焦点至有效数据行
    With BanlGrid2
        If .Row < .FixedRows And .Rows > .FixedRows Then
            Changelock = True
            .Select .FixedRows, .Col
            Changelock = False
        End If
        If .Col < Qslz Then
            Changelock = True
            .Select .Row, Qslz
            Changelock = False
        End If
    End With
End Sub
Private Sub BanlGrid2_LostFocus()                                          '录入网格失去焦点
    '用以屏蔽调用其它窗体时发生网格失去焦点事件
    If Changelock Then
        Exit Sub
    End If
    '引发网格RowcolChange事件
    With BanlGrid2
        If Not (Ydtext.Visible Or YdCombo.Visible) Then
            .Select 0, 0
        End If
    End With
End Sub
Private Sub BanlGrid2_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                             '限制用户在录入过程中滚动鼠标
    If Gdtlock Then
        Exit Sub
    End If
 
    With BanlGrid2
        If Ydtext.Visible Or YdCombo.Visible Then
            Gdtlock = True
            .TopRow = Dqtoprow
            .LeftCol = Dqleftcol
            Gdtlock = False
            Exit Sub
        End If
    End With
    
End Sub
Private Sub BanlGrid2_LeaveCell()                                    '离开单元格
    If Changelock Then
        Exit Sub
    End If
    '记录刚刚离开网格单元的行列值
    Dqlkwgh = BanlGrid2.Row
    Dqlkwgl = BanlGrid2.Col
    '判断是否需要录入数据回写
    If Not (Ydtext.Visible Or YdCombo.Visible) Then
        Exit Sub
    End If
    
    Call Lrsjhx
    
End Sub
Private Sub BanlGrid2_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
   
    Valilock = True       '屏蔽文本框失去焦点进行有效性判断
    
    With BanlGrid2
        If Changelock Then
            Exit Sub
        End If
        If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
            Exit Sub
        End If
        If .Row <> Dqlkwgh Then
            If Not Sjhzyxxpd(Dqlkwgh) Then
                Exit Sub
            End If
        End If
   End With
   
   Call fhyxh
   Call Xldql
   
End Sub
Private Sub BanlGrid2_DblClick()                                    '鼠标双击网格显示文本框
  
    With BanlGrid2
        Call xswbk
    End With
    
End Sub
Private Sub Ycwbk()                                                '隐藏文本框,帮助按钮,列表组合框
    
    Valilock = True
    Ydtext.Visible = False
    YdCombo.Visible = False
    Ydcommand.Visible = False
    
End Sub
Private Sub SzToolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    If Trim(Ydtext) = "" Then
        Call Ycwbk
    End If
        Select Case Button.Key
            Case "ymsz"                                          '页面设置
               Dyymctbl.Show 1
            Case "yl"                                            '预 览
               Call bbyl(True)
            Case "dy"                                            '打 印
               Call bbyl(False)
            Case "gl"
               Balance_KF_Query.Show 1
            Case "fp"
               Balance_KF_Invoice.Now_FilterCondition = FilterInvoice
               Balance_KF_Invoice.Show 1
            Case "rkd"
               Balance_KF_InOut.Now_FilterCondition = FilterInOut
               Balance_KF_InOut.Show 1
            Case "js"
               If Fun_Drfrmyxxpd Then Call Sub_HandBalance
               
            Case "bz"                                            '帮 助
               Call F1bz
            Case "fh"                                            '退 出
            Unload Me
       End Select
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
Dim jsqte As Integer
    FilterInvoice = " where 1=1 "
    FilterInOut = " where 1=1 "
 With Balance_KF_Query
    For jsqte = 1 To 5
    Select Case jsqte
        Case 1  '查询日期范围(起始)
            If Trim(.LrText(0).Text) <> "" Then
                FilterInvoice = FilterInvoice & " And InvoiceDate>=convert(datetime,'" & Trim(.LrText(0).Text) & "')"
                FilterInOut = FilterInOut & " And BillDate>=convert(datetime,'" & Trim(.LrText(0).Text) & "')"
            End If
        Case 2  '查询日期范围(终止)
            If Trim(.LrText(1).Text) <> "" Then
                FilterInvoice = FilterInvoice & " And InvoiceDate<= convert(datetime,'" & Trim(.LrText(1).Text) & "')"
                FilterInOut = FilterInOut & " And BillDate<= convert(datetime,'" & Trim(.LrText(1).Text) & "')"
            End If
        Case 3  '供应商(Like)
            If Trim(.LrText(2).Text) <> "" Then
                FilterInvoice = FilterInvoice & " And ( SupplierCode like '%" & Trim(.LrText(2).Text) & "%' or SupplierName like '%" & Trim(.LrText(2).Text) & "%')"
                FilterInOut = FilterInOut & " And ( SupplierCode like '%" & Trim(.LrText(2).Text) & "%' or SupplierName like '%" & Trim(.LrText(2).Text) & "%')"
            End If
        Case 4  '物料分类
            If Trim(.LrText(3).Text) <> "" Then
                FilterInvoice = FilterInvoice & " and InvSortcode like '" & Trim(.LrText(3).Tag) & "%'"
                FilterInOut = FilterInOut & " and InvSortcode like '" & Trim(.LrText(3).Tag) & "%'"
            End If
        Case 5  '物料
            If Trim(.LrText(4).Text) <> "" Then
                FilterInvoice = FilterInvoice & " and MNumber like  '%" & Trim(.LrText(4).Text) & "%'"
                FilterInOut = FilterInOut & " and MNumber like  '%" & Trim(.LrText(4).Text) & "%'"
            End If
    End Select
    Next
  End With
     FilterInOut = FilterInOut & " And WhCode in (select whcode from KF_V_WhLimit where ltrim(rtrim(Czybm))='" & Xtczybm & "')"
End Sub
Private Sub Timer2_Timer()
Timer2.Enabled = False
    Dim int_temp As Integer
    Dim rst_temp As New ADODB.Recordset
    Dim str_sqlTemp As String
    Dim Jsqte1 As Integer
    Dim Jsqte2 As Integer
    
    BanlGrid1.Rows = BanlGrid1.FixedRows
    BanlGrid2.Rows = BanlGrid2.FixedRows
    str_sqlTemp = "SELECT 0 as IsInvoice, InOutMainId as Mainid, InOutSubId as SubId, MNumber, MName, Model, PrimaryUnitName, BillNum, " & _
                          " '' AS InvoiceNum, FactReceiptQuan, 0 AS InvoiceQuan, Price, 0 AS InvoicePriceBb, " & _
                          " EMoney, 0 AS InvoiceTotalMoneyBb, 0 AS Ischarge ,'' as SupplierCode,'' as SupplierName " & _
                    " From KF_V_BalanceInOut " & "Where " & Me.InOut_FilterCondition & _
                    " Union " & _
                    " SELECT 1 as IsInvoice,InvoiceMainID as Mainid, InvoiceSubID as Subid , MNumber, MName, Model, PrimaryUnitName, " & _
                          " '' AS InoutNum, InvoiceNum, 0 AS InOutQuan, Quantity, 0 AS InoutPrice, PriceBb, " & _
                          " 0 AS InOutMoney, TotalMoneyBb, IsCharge ,SupplierCode, SupplierName" & _
                    " From KF_V_BalanceInvoice  where " & Me.Invoice_FilterCondition & _
                    " ORDER BY MNumber, IsInvoice "
    Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
    Jsqte1 = BanlGrid1.FixedRows
    Jsqte2 = BanlGrid2.FixedRows
    If rst_temp.RecordCount <> 0 Then
        rst_temp.MoveFirst
        For int_temp = 1 To rst_temp.RecordCount
            If rst_temp.Fields("IsCharge") = False Then   '是否费用
                With BanlGrid1
                    If Jsqte1 >= .Rows Then
                       .AddItem ""
                    End If
                    .TextMatrix(Jsqte1, 0) = Trim("" & rst_temp.Fields("MNumber"))
                    .TextMatrix(Jsqte1, 1) = rst_temp.Fields("IsInvoice")
                    .TextMatrix(Jsqte1, 2) = rst_temp.Fields("Mainid")                        '主表ID
                    .TextMatrix(Jsqte1, 3) = rst_temp.Fields("SubId")                        '子表ID
                    .TextMatrix(Jsqte1, Sydz("001", GridStr1(), Szzls1)) = Trim("" & rst_temp.Fields("MNumber"))
                    .TextMatrix(Jsqte1, Sydz("002", GridStr1(), Szzls1)) = Trim("" & rst_temp.Fields("MName"))
                    .TextMatrix(Jsqte1, Sydz("003", GridStr1(), Szzls1)) = Trim(rst_temp.Fields("Model") & "")
                    .TextMatrix(Jsqte1, Sydz("004", GridStr1(), Szzls1)) = Trim(rst_temp.Fields("PrimaryUnitName") & "")
                    .TextMatrix(Jsqte1, Sydz("005", GridStr1(), Szzls1)) = Trim(rst_temp.Fields("BillNum") & "")
                    .TextMatrix(Jsqte1, Sydz("006", GridStr1(), Szzls1)) = Trim("" & rst_temp.Fields("InvoiceNum"))
                    .TextMatrix(Jsqte1, Sydz("007", GridStr1(), Szzls1)) = IIf(IsNull(rst_temp.Fields("FactReceiptQuan")) Or rst_temp.Fields("FactReceiptQuan") = 0, "", rst_temp.Fields("FactReceiptQuan"))
                    .TextMatrix(Jsqte1, Sydz("008", GridStr1(), Szzls1)) = IIf(IsNull(rst_temp.Fields("InvoiceQuan")) Or rst_temp.Fields("InvoiceQuan") = 0, "", rst_temp.Fields("InvoiceQuan"))
                    .TextMatrix(Jsqte1, Sydz("009", GridStr1(), Szzls1)) = IIf(IsNull(rst_temp.Fields("Price")) Or rst_temp.Fields("Price") = 0, "", rst_temp.Fields("Price"))
                    .TextMatrix(Jsqte1, Sydz("010", GridStr1(), Szzls1)) = IIf(IsNull(rst_temp.Fields("InvoicePriceBb")) Or rst_temp.Fields("InvoicePriceBb") = 0, "", rst_temp.Fields("InvoicePriceBb"))
                    .TextMatrix(Jsqte1, Sydz("011", GridStr1(), Szzls1)) = IIf(IsNull(rst_temp.Fields("EMoney")) Or rst_temp.Fields("EMoney") = 0, "", rst_temp.Fields("EMoney"))
                    .TextMatrix(Jsqte1, Sydz("012", GridStr1(), Szzls1)) = IIf(IsNull(rst_temp.Fields("InvoiceTotalMoneyBb")) Or rst_temp.Fields("InvoiceTotalMoneyBb") = 0, "", rst_temp.Fields("InvoiceTotalMoneyBb"))
                    .RowHeight(Jsqte1) = Sjhgd1
                    Jsqte1 = Jsqte1 + 1
                End With
            ElseIf rst_temp.Fields("IsCharge") = 1 And rst_temp.Fields("IsInvoice") = 1 Then
                With BanlGrid2
                    If Jsqte2 >= .Rows Then
                       .AddItem ""
                    End If
                    .TextMatrix(Jsqte2, 1) = rst_temp.Fields("IsInvoice")
                    .TextMatrix(Jsqte2, 2) = rst_temp.Fields("Mainid")                        '主表ID
                    .TextMatrix(Jsqte2, 3) = rst_temp.Fields("SubId")                        '子表ID
                    .TextMatrix(Jsqte2, Sydz("001", GridStr(), Szzls)) = Trim("" & rst_temp.Fields("MNumber"))                  '
                    .TextMatrix(Jsqte2, Sydz("002", GridStr(), Szzls)) = Trim("" & rst_temp.Fields("MName"))
                    .TextMatrix(Jsqte2, Sydz("003", GridStr(), Szzls)) = Trim(rst_temp.Fields("Model") & "")
                    .TextMatrix(Jsqte2, Sydz("004", GridStr(), Szzls)) = Trim(rst_temp.Fields("PrimaryUnitName") & "")
                    .TextMatrix(Jsqte2, Sydz("005", GridStr(), Szzls)) = Trim(rst_temp.Fields("InvoiceNum") & "")
                    .TextMatrix(Jsqte2, Sydz("006", GridStr(), Szzls)) = IIf(IsNull(rst_temp.Fields("InvoiceQuan")) Or rst_temp.Fields("InvoiceQuan") = 0, "", rst_temp.Fields("InvoiceQuan"))
                    .TextMatrix(Jsqte2, Sydz("007", GridStr(), Szzls)) = IIf(IsNull(rst_temp.Fields("InvoiceTotalMoneyBb")) Or rst_temp.Fields("InvoiceTotalMoneyBb") = 0, "", rst_temp.Fields("InvoiceTotalMoneyBb"))
                    .TextMatrix(Jsqte2, Sydz("008", GridStr(), Szzls)) = Trim("" & rst_temp.Fields("SupplierName"))
                    .RowHeight(Jsqte2) = Sjhgd
                    Jsqte2 = Jsqte2 + 1
                End With
            End If
            rst_temp.MoveNext
        Next int_temp
    End If
    rst_temp.Close
    Set rst_temp = Nothing
    Call SubTotal '加入小合计
        
'''''''''''''''
        For int_temp = BanlGrid1.FixedRows To BanlGrid1.Rows - 1
            If BanlGrid1.IsSubtotal(int_temp) = True Then
                 BanlGrid1.TextMatrix(int_temp, Sydz("001", GridStr1(), Szzls1)) = "合 计"
            End If
        Next int_temp
''''''''''''''''
End Sub
Private Sub SubTotal()
Dim int_temp As Integer
    If BanlGrid1.Rows <> BanlGrid1.FixedRows Then
       BanlGrid1.BackColorAlternate = &H80000005
       BanlGrid1.SubTotal flexSTSum, 0, Sydz("007", GridStr1(), Szzls1), , &HF7F3EC, , , "合计"
       BanlGrid1.SubTotal flexSTSum, 0, Sydz("008", GridStr1(), Szzls1), , &HF7F3EC, , , "合计"
       BanlGrid1.SubTotal flexSTSum, 0, Sydz("011", GridStr1(), Szzls1), , &HF7F3EC, , , "合计"
       BanlGrid1.SubTotal flexSTSum, 0, Sydz("012", GridStr1(), Szzls1), , &HF7F3EC, , , "合计"
       BanlGrid1.SubTotal flexSTSum, 0, Sydz("013", GridStr1(), Szzls1), , &HF7F3EC, , , "合计"
       BanlGrid1.SubTotal flexSTSum, 0, Sydz("014", GridStr1(), Szzls1), , &HF7F3EC, , , "合计"
       BanlGrid1.SubTotal flexSTSum, 0, Sydz("015", GridStr1(), Szzls1), , &HF7F3EC, , , "合计"
        For int_temp = BanlGrid1.FixedRows To BanlGrid1.Rows - 1
            If BanlGrid1.IsSubtotal(int_temp) = True Then
                 If BanlGrid1.ValueMatrix(int_temp, Sydz("007", GridStr1(), Szzls1)) = 0 Then
                    BanlGrid1.TextMatrix(int_temp, Sydz("007", GridStr1(), Szzls1)) = ""
                 End If
                 If BanlGrid1.ValueMatrix(int_temp, Sydz("008", GridStr1(), Szzls1)) = 0 Then
                    BanlGrid1.TextMatrix(int_temp, Sydz("008", GridStr1(), Szzls1)) = ""
                 End If
                 If BanlGrid1.ValueMatrix(int_temp, Sydz("011", GridStr1(), Szzls1)) = 0 Then
                    BanlGrid1.TextMatrix(int_temp, Sydz("011", GridStr1(), Szzls1)) = ""
                 End If
                 If BanlGrid1.ValueMatrix(int_temp, Sydz("012", GridStr1(), Szzls1)) = 0 Then
                    BanlGrid1.TextMatrix(int_temp, Sydz("012", GridStr1(), Szzls1)) = ""
                 End If
                 If BanlGrid1.ValueMatrix(int_temp, Sydz("013", GridStr1(), Szzls1)) = 0 Then
                    BanlGrid1.TextMatrix(int_temp, Sydz("013", GridStr1(), Szzls1)) = ""
                 End If
                 If BanlGrid1.ValueMatrix(int_temp, Sydz("014", GridStr1(), Szzls1)) = 0 Then
                    BanlGrid1.TextMatrix(int_temp, Sydz("014", GridStr1(), Szzls1)) = ""
                 End If
                 If BanlGrid1.ValueMatrix(int_temp, Sydz("015", GridStr1(), Szzls1)) = 0 Then
                    BanlGrid1.TextMatrix(int_temp, Sydz("015", GridStr1(), Szzls1)) = ""
                 End If
            End If
        Next int_temp
    End If
End Sub
Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
    
    With BanlGrid2
        Select Case KeyCode
            Case vbKeyEscape                'ESC 键放弃录入
                Valilock = True
                .SetFocus
                Call Ycwbk
                Valilock = False
                
            Case vbKeyReturn                '回 车 键 =13
                KeyCode = 0
                .SetFocus
                Call Lrsjhx
                Rowjsq = .Row
                Coljsq = .Col + 1
                If Coljsq > .Cols - 1 Then
                    If Rowjsq < .Rows - 1 Then
                        Rowjsq = Rowjsq + 1
                    End If
                    Coljsq = Qslz
                End If
                Do While Rowjsq <= .Rows - 1
                    If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                        Coljsq = Coljsq + 1
                        If Coljsq > .Cols - 1 Then
                            Rowjsq = Rowjsq + 1
                            Coljsq = Qslz
                        End If
                    Else
                        Exit Do
                    End If
                Loop
                .Select Rowjsq, Coljsq
                
            Case vbKeyLeft                  '左 箭 头 =37
                If .Col - 1 = Qslz Then
                    If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                        GoTo jzzx
                    End If
                End If
                If .Col > Qslz Then
                    KeyCode = 0
                    .SetFocus
                    Call Lrsjhx
                    Coljsq = .Col - 1
                    Do While Coljsq > Qslz
                        If Coljsq - 1 = Qslz Then
                            If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                                GoTo jzzx
                            End If
                        End If
                        If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                            Coljsq = Coljsq - 1
                        Else
                            Exit Do
                        End If
                    Loop
                    .Select .Row, Coljsq
                End If
            Case vbKeyRight                 '右 箭 头 =39
                KeyCode = 0
                .SetFocus
                Call Lrsjhx
                Rowjsq = .Row
                Coljsq = .Col + 1
                If Coljsq > .Cols - 1 Then
                    If Rowjsq < .Rows - 1 Then
                        Rowjsq = Rowjsq + 1
                    End If
                    Coljsq = Qslz
                End If
                Do While Rowjsq <= .Rows - 1
                    If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                        Coljsq = Coljsq + 1
                        If Coljsq > .Cols - 1 Then
                            Rowjsq = Rowjsq + 1
                            Coljsq = Qslz
                        End If
                    Else
                        Exit Do
                    End If
                Loop
                .Select Rowjsq, Coljsq
        Case Else
    End Select
   
jzzx:
   
    End With
    
End Sub
Private Sub YdCombo_LostFocus()                    '列表框失去焦点
    
    With BanlGrid2                                    '因为选中网格会先发生Rowcolchange事件置Valiock
        If Not Valilock Then                           '为TRUE
            Call Lrsjhx
            If Not Sjhzyxxpd(Dqlrwgh) Then
                Exit Sub
            End If
        End If
    End With
    
End Sub
Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    Call Lrzdbz
    
End Sub
Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
   
    Dim Rowjsq As Long, Coljsq As Long
   
    With BanlGrid2
        Select Case KeyCode
            Case vbKeyF2
                Call Lrzdbz
            Case vbKeyEscape                'ESC 键放弃录入
                Valilock = True
                Call Ycwbk
                .SetFocus
            Case vbKeyReturn                '回 车 键 =13
                KeyCode = 0
                .SetFocus
                Call Lrsjhx
                Rowjsq = .Row
                Coljsq = .Col + 1
                If Coljsq > .Cols - 1 Then
                    If Rowjsq < .Rows - 1 Then
                        Rowjsq = Rowjsq + 1
                    End If
                    Coljsq = Qslz
                End If
                Do While Rowjsq <= .Rows - 1
                    If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                        Coljsq = Coljsq + 1
                        If Coljsq > .Cols - 1 Then
                            Rowjsq = Rowjsq + 1
                            Coljsq = Qslz
                        End If
                    Else
                        Exit Do
                    End If
                Loop
                If Rowjsq <= .Rows - 1 Then
                    .Select Rowjsq, Coljsq
                End If
                
            Case vbKeyUp                    '上 箭 头 =38
                KeyCode = 0
                .SetFocus
                Call Lrsjhx
                If .Row > .FixedRows Then
                    .Row = .Row - 1
                End If
                
            Case vbKeyDown                  '下 箭 头 =40
                KeyCode = 0
                .SetFocus
                Call Lrsjhx
                If .Row < .Rows - 1 Then
                    .Row = .Row + 1
                End If
            Case vbKeyLeft                  '左 箭 头 =37
                If .Col - 1 = Qslz Then
                    If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                        GoTo jzzx
                    End If
                End If
                If Ydtext.SelStart = 0 And .Col > Qslz Then
                    KeyCode = 0
                    .SetFocus
                    Call Lrsjhx
                    Coljsq = .Col - 1
                    Do While Coljsq > Qslz
                        If Coljsq - 1 = Qslz Then
                            If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                                GoTo jzzx
                            End If
                        End If
                        If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                            Coljsq = Coljsq - 1
                        Else
                            Exit Do
                        End If
                    Loop
                    .Select .Row, Coljsq
                End If
jzzx:
           
           
            Case vbKeyRight                 '右 箭 头 =39
                wblong = Len(Ydtext.Text)
                If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
                    KeyCode = 0
                    .SetFocus
                    Call Lrsjhx
                    Rowjsq = .Row
                    Coljsq = .Col + 1
                    If Coljsq > .Cols - 1 Then
                        If Rowjsq < .Rows - 1 Then
                            Rowjsq = Rowjsq + 1
                        End If
                        Coljsq = Qslz
                    End If
                    Do While Rowjsq <= .Rows - 1
                        If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                            Coljsq = Coljsq + 1
                            If Coljsq > .Cols - 1 Then
                                Rowjsq = Rowjsq + 1
                                Coljsq = Qslz
                            End If
                        Else
                            Exit Do
                        End If
                    Loop
                    .Select Rowjsq, Coljsq
                End If
            Case Else
        End Select
    End With
    
End Sub
Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  
    Call InputFieldLimit(Ydtext, GridInt(BanlGrid2.Col, 1), KeyAscii)
End Sub
Private Sub ydtext_Change()                              '录入事中变化处理
    '防止程序改变但不进行处理
    If Wbkbhlock Then
         Exit Sub
    End If
    With BanlGrid2
        '限制字段录入长度
        Wbkbhlock = True
        
        Select Case GridInt(.Col, 1)
            Case 8, 11   '金额型
                Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
            Case 9, 12   '数量型
                Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
            Case 10      '单价型
                Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
            Case Else    '其他类型
                If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
                    Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
                End If
        End Select
        
        Wbkbhlock = False
    End With
    
End Sub
Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  
    With BanlGrid2
        If Not Valilock Then
            Call Lrsjhx
            If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
                Exit Sub
            End If
            If Not Sjhzyxxpd(Dqlrwgh) Then
                Exit Sub
            End If
        End If
    End With
  
End Sub
Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  
    Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  
    '当某种条件成立时禁止文本框激活使单据处于录入状态
    If Not Fun_AllowInput Then
        Exit Sub
    End If
  
    '显示文本框前返回有效行列（解决滚动条问题）
    Call Xldqh
    Call Xldql
  
    '隐藏文本框,帮助按钮,列表组合框
    Call Ycwbk
  
    With BanlGrid2
        Dqlrwgh = .Row
        Dqlrwgl = .Col
        If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
            Exit Sub
        End If
     
        Wbkpy = 30
        Wbkpy1 = 15
    
        On Error Resume Next
        
        If GridBoolean(.Col, 3) Then
            YdCombo.Left = .CellLeft + .Left + Wbkpy
            YdCombo.Top = .CellTop + .Top + Wbkpy
            YdCombo.Width = .CellWidth - Wbkpy1
            Call Wbkcl
            YdCombo.Visible = True
            YdCombo.SetFocus
            Ydcommand.Visible = False
            Ydtext.Visible = False
        Else
            If GridBoolean(.Col, 2) Then
                Ydcommand.Height = .RowHeight(.Row)  'remonstrate
                Ydcommand.Width = Ydcommand.Height
                Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
                Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
                Ydcommand.Visible = True
            Else
                Ydcommand.Visible = False
            End If
     
            Ydtext.Left = .CellLeft + .Left + Wbkpy
            Ydtext.Top = .CellTop + .Top + Wbkpy
            
            If Ydcommand.Visible Then
                If Sfblbzkd Then
                    Ydtext.Width = .CellWidth - Ydcommand.Width
                Else
                    Ydtext.Width = .CellWidth - Wbkpy1
                End If
            Else
                Ydtext.Width = .CellWidth - Wbkpy1
            End If
            
            Ydtext.Height = .CellHeight - Wbkpy1
      
            If GridInt(.Col, 2) <> 0 Then
                Ydtext.MaxLength = GridInt(.Col, 2)
            Else
                Ydtext.MaxLength = 3000
            End If
      
            Call Wbkcl
      
            Ydtext.Visible = True
            Ydtext.SetFocus
        End If
    
        Dqtoprow = .TopRow
        Dqleftcol = .LeftCol
    
        '重置锁值
        Valilock = False
        Wbkbhlock = False
    End With
 
End Sub
Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
   
    '如果单据操作状态为浏览状态则不能显示录入载体(通用)
'    If Trim(Lab_OperStatus.Caption) = "1" Then
'        Exit Function
'    End If
   
    '[>>
    
        '此处可以填写禁止文本框激活使单据处于录入状态的理由
   
    '<<]
   
    Fun_AllowInput = True
    
End Function
Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
                   
    Dim Wbkpy As Integer, Wbkpy1 As Integer
    
    Wbkpy = 30
    Wbkpy1 = 15
    
    With BanlGrid2
        If YdCombo.Visible Then
            YdCombo.Left = .CellLeft + .Left + Wbkpy
            YdCombo.Top = .CellTop + .Top + Wbkpy
            YdCombo.Width = .CellWidth - Wbkpy1
        End If
        If Ydcommand.Visible Then
            Ydcommand.Height = .RowHeight(.Row) 'remonstrate
            Ydcommand.Width = Ydcommand.Height
            Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
            Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
        End If
        If Ydtext.Visible Then
            If Ydcommand.Visible Then
                If Sfblbzkd Then
                    Ydtext.Width = .CellWidth - Ydcommand.Width
                Else
                    Ydtext.Width = .CellWidth - Wbkpy1
                End If
            Else
                Ydtext.Width = .CellWidth - Wbkpy1
            End If
      
            Ydtext.Left = .CellLeft + .Left + Wbkpy
            Ydtext.Top = .CellTop + .Top + Wbkpy
            Ydtext.Height = .CellHeight - Wbkpy1
        End If
    End With
   Call Xldql
End Sub
Private Sub Lrsjhx()                                                             '文本框录入数据回写
  
    With BanlGrid2
        If YdCombo.Visible Then
            .Text = Trim(YdCombo.Text)
        End If
        If Ydtext.Visible Then
            .Text = Trim(Ydtext.Text)
        End If
   
        '(如果字段录入内容发生变化,则打开有效性判断锁)
        If Zdlrqnr <> Trim(.Text) Then
            Yxxpdlock = False
            Hyxxpdlock = False
        End If
   
        '隐藏文本框,帮助按钮,列表组合框
        Call Ycwbk
   
    End With
    
End Sub
Private Sub BanlGrid2_KeyDown(KeyCode As Integer, Shift As Integer)              '网格快捷键
  
    '如果单据操作状态为浏览状态则不能显示录入载体
'    If Trim(Lab_OperStatus.Caption) = "1" Then
'        Exit Sub
'    End If
    Select Case KeyCode
        Case vbKeyF2                   '按F2键参照
            Call xswbk
            Call Lrzdbz
    End Select
End Sub
Private Sub BanlGrid2_KeyPress(KeyAscii As Integer)                              '网格接受键盘录入
    '当某种条件成立时禁止文本框激活使单据处于录入状态
    If Not Fun_AllowInput Then
        Exit Sub
    End If
  
    With BanlGrid2
  
        '屏 蔽 回 车 键
        If KeyAscii = vbKeyReturn Then
            KeyAscii = 0
            Rowjsq = .Row
            Coljsq = .Col + 1
            If Coljsq > .Cols - 1 Then
                If Rowjsq < .Rows - 1 Then
                    Rowjsq = Rowjsq + 1
                End If
                Coljsq = Qslz
            End If
            Do While Rowjsq <= .Rows - 1
                If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                    Coljsq = Coljsq + 1
                    If Coljsq > .Cols - 1 Then
                        Rowjsq = Rowjsq + 1
                        Coljsq = Qslz
                    End If
                Else
                    Exit Do
                End If
            Loop
          
            If Rowjsq <= .Rows - 1 Then
                .Select Rowjsq, Coljsq
            End If
       
            Exit Sub
       
        End If
     
        '接受用户录入
        Select Case KeyAscii
            Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
                '显示录入载体
                Call xswbk
            Case Else
                
                '防止非编辑字段SendKeys()出现死循环
                If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
                    Exit Sub
                End If
                
                '如果此字段为列表框录入则调入相应列表框
                If GridBoolean(.Col, 3) Then
                   '列表框录入
                    Call xswbk
                Else
                    Ydtext.Text = ""
            
                    '录入限制
                    Call InputFieldLimit(Ydtext, GridInt(BanlGrid2.Col, 1), KeyAscii)
                    If KeyAscii = 0 Then
                        Exit Sub
                    End If
                    Call xswbk
                    Ydtext.Text = ""
                    Valilock = True
                    SendKeys Chr(KeyAscii), True
                    DoEvents
                    Valilock = False
                End If
        End Select
    End With
End Sub
Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
    
    If Not GridBoolean(Sjl, 5) Then
        Exit Sub
    End If
    
    With BanlGrid2
        If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
            .TextMatrix(sjh, Sjl) = ""
        End If
    End With
End Sub
Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
    
    With BanlGrid2
        If .Row >= .FixedRows Then
            Call Xldqh
        End If
    End With
End Sub
Private Sub Xldqh()                                                      '显露当前行
    
    Dim Toprowte As Long
    With BanlGrid2
        Toprowte = 0
        Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
            Toprowte = .TopRow
            .TopRow = .TopRow + 1
        Loop
        Toprowte = 0
        Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
            Toprowte = .TopRow
            If .TopRow > 1 Then
                .TopRow = .TopRow - 1
            End If
        Loop
    End With
End Sub
Private Sub Xldql()                                                                  '显露当前列
    
    Dim Leftcolte As Long
    With BanlGrid2
        If .Col >= Qslz And .Col >= .FixedCols Then
            If .LeftCol > .Col Then
                .LeftCol = .Col
            End If
            Leftcolte = 0
            Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
                Leftcolte = .LeftCol
                .LeftCol = .LeftCol + 1
            Loop
        End If
    End With
End Sub
Private Sub BanlGrid2_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
End Sub
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
    Call Scyxsjb(BanlGrid1)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
End Sub
Private Sub Sub_HandBalance()
        Dim int_temp As Integer
        Select Case Left(Trim(Combo1.Text), 1)
            Case "1" '入库单、发票、费用发票结算
                If BanlGrid1.FixedRows = BanlGrid1.Rows Then
                    Tsxx = "必须同时选择发票和入库单且发票数量(实物)等于入库单数量!"
                    Call Xtxxts(Tsxx, 0, 1)
                    Exit Sub
                End If
                With BanlGrid1
                    For int_temp = .FixedRows To .Rows - 1  '判断处有一点问题,不能解决入库单合正好为零的情况
                        If .IsSubtotal(int_temp) = True Then
                            If Abs(.ValueMatrix(int_temp, Sydz("007", GridStr1(), Szzls1)) - (.ValueMatrix(int_temp, Sydz("008", GridStr1(), Szzls1)) - .ValueMatrix(int_temp, Sydz("013", GridStr1(), Szzls1)) - .ValueMatrix(int_temp, Sydz("014", GridStr1(), Szzls1)))) > 0.0000001 Then
                                Tsxx = "必须同时选择发票和入库单且发票数量(实物)等于入库单数量!"
                                Call Xtxxts(Tsxx, 0, 1)
                                Exit Sub
                            End If
                            If (.ValueMatrix(int_temp, Sydz("008", GridStr1(), Szzls1)) - .ValueMatrix(int_temp, Sydz("013", GridStr1(), Szzls1)) - .ValueMatrix(int_temp, Sydz("014", GridStr1(), Szzls1))) = 0 Then
                                Tsxx = "必须同时选择发票和入库单且发票数量(实物)等于入库单数量!"
                                Call Xtxxts(Tsxx, 0, 1)
                                Exit Sub
                            End If
                        End If
                    Next int_temp
                End With
            Case "2" '入库单、发票结算
                If BanlGrid1.FixedRows = BanlGrid1.Rows Then
                    Tsxx = "必须同时选择发票和入库单且发票数量(实物)等于入库单数量!"
                    Call Xtxxts(Tsxx, 0, 1)
                    Exit Sub
                End If
                If BanlGrid2.FixedRows <> BanlGrid2.Rows Then
                    Tsxx = "所选发票中有费用存在!"
                    Call Xtxxts(Tsxx, 0, 1)
                    Exit Sub
                End If
                With BanlGrid1
                   For int_temp = .FixedRows To .Rows - 1
                        If .IsSubtotal(int_temp) = True Then
                            If Abs(.ValueMatrix(int_temp, Sydz("007", GridStr1(), Szzls1)) - (.ValueMatrix(int_temp, Sydz("008", GridStr1(), Szzls1)) - .ValueMatrix(int_temp, Sydz("013", GridStr1(), Szzls1)) - .ValueMatrix(int_temp, Sydz("014", GridStr1(), Szzls1)))) > 0.0000001 Then
                                Tsxx = "必须同时选择发票和入库单且发票数量(实物)等于入库单数量!"
                                Call Xtxxts(Tsxx, 0, 1)
                                Exit Sub
                            End If
                            If (.ValueMatrix(int_temp, Sydz("008", GridStr1(), Szzls1)) - .ValueMatrix(int_temp, Sydz("013", GridStr1(), Szzls1)) - .ValueMatrix(int_temp, Sydz("014", GridStr1(), Szzls1))) = 0 Then
                                Tsxx = "必须同时选择发票和入库单且发票数量(实物)等于入库单数量!"
                                Call Xtxxts(Tsxx, 0, 1)
                                Exit Sub
                            End If
                        End If
                   Next int_temp
                End With
            Case "3" '费用发票单独结算
                If BanlGrid1.FixedRows <> BanlGrid1.Rows Then
                    Tsxx = "只能选择全是费用的发票!"
                    Call Xtxxts(Tsxx, 0, 1)
                    Exit Sub
                End If
                If BanlGrid2.FixedRows = BanlGrid2.Rows Then
                    Tsxx = "未选择费用发票!"
                    Call Xtxxts(Tsxx, 0, 1)
                    Exit Sub
                End If
                With BanlGrid2
                    For int_temp = .FixedRows To .Rows - 1
                        If Trim(.TextMatrix(int_temp, Sydz("009", GridStr(), Szzls))) = "" Or Trim(.TextMatrix(int_temp, Sydz("010", GridStr(), Szzls))) = "" Then
                            banl_flag = False
                            Tsxx = "费用发票单独结算时必须输入对应仓库和对应物料!"
                            Call Xtxxts(Tsxx, 0, 1)
                            Exit Sub
                        End If
                    Next
                End With
            Case "4" '正负发票结算
                Exit Sub
            Case "5" '正负入库单结算
                Exit Sub
            Case Else
                Tsxx = "未选择结算方式!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
        End Select
            Cw_DataEnvi.DataConnect.BeginTrans
            If Fun_HandBalanceExecute(Left(Trim(Combo1.Text), 1)) = True Then
                Cw_DataEnvi.DataConnect.CommitTrans
                Tsxx = "结算完成!"
                Call Xtxxts(Tsxx, 0, 4)
                BanlGrid1.Rows = BanlGrid1.FixedRows
                BanlGrid2.Rows = BanlGrid2.FixedRows
            Else
                Cw_DataEnvi.DataConnect.RollbackTrans
            End If
            ProgressBar1.Visible = False
End Sub
Private Function Fun_HandBalanceExecute(BalanceType As String) As Boolean
    Dim int_temp As Integer
    Dim str_sqlTemp As String
    Dim str_temp As String
    Dim rst_temp As New ADODB.Recordset
    Dim str_UpdateSql As String
    Dim str_InsertSql As String
    Dim Lng_TotalMoney As Double                     '发票总金额（包括非合理损耗）
    Dim lng_TotalQuantity As Double                      '发票总数量
    Dim lng_WasteMoneyPercentage As Double               '按金额比率
    Dim lng_WasteQuantityPercentage As Double            '按数量比率
    Dim lng_NotinreasonWasteMoney As Double              '非合理损耗金额总额
    Dim Lng_TotalMoneyInvoice As Double                  '发票总金额除非合理损耗
    Dim Lng_WasteMoney As Double                         '分摊费用总额
    Dim Lng_TotalquanInOut As Double                     '入库单的实物数量
    
    Dim int_MainId As Integer                         '结算单主Id
    Dim str_BillCode As String
    Dim str_WhCode As String
    Dim str_MNumber As String
    Dim RKd_MainCode As String
    Dim RKd_MainId As Integer
    Dim str_SupplierCode As String
On Error GoTo errExecute
    Select Case BalanceType
        Case "1", "2"
            ProgressBar1.Max = (BanlGrid2.Rows - 1) * 15 + (BanlGrid1.Rows - 1) * 10 + 60
            Call ProgressBar_move
            Lng_WasteMoney = 0
            If BanlGrid2.FixedRows <> BanlGrid2.Rows Then
                For int_temp = BanlGrid2.FixedRows To BanlGrid2.Rows - 1
                    If Trim(BanlGrid2.TextMatrix(int_temp, Sydz("009", GridStr(), Szzls))) = "" Or Trim(BanlGrid2.TextMatrix(int_temp, Sydz("010", GridStr(), Szzls))) = "" Then
                        Lng_WasteMoney = Lng_WasteMoney + BanlGrid2.ValueMatrix(int_temp, Sydz("007", GridStr(), Szzls))
                    End If
                Next int_temp
            End If
            lng_NotinreasonWasteMoney = 0
            Call ProgressBar_move
            With BanlGrid1
                For int_temp = .FixedRows To .Rows - 1
                Call ProgressBar_move
                    If .IsSubtotal(int_temp) = False And .ValueMatrix(int_temp, 1) = 1 Then    '回写发票
                        str_UpdateSql = "UPDATE Cg_InvoiceSub " & _
                                        " SET InreasonWasteQuan =" & .ValueMatrix(int_temp, Sydz("013", GridStr1(), Szzls1)) & "/ (isnull((SELECT TOP 1 (A.PurInvCon1 / A.PurInvCon2) FROM Gy_Material A WHERE Mnumber = Cg_InvoiceSub.Mnumber), 1)) " & _
                                        " , NotinreasonWasteQuan =" & .ValueMatrix(int_temp, Sydz("014", GridStr1(), Szzls1)) & "/ (isnull((SELECT TOP 1 (A.PurInvCon1 / A.PurInvCon2) FROM Gy_Material A WHERE Mnumber = Cg_InvoiceSub.Mnumber), 1)) " & _
                                        ", NotinreasonWasteMoney = " & .ValueMatrix(int_temp, Sydz("015", GridStr1(), Szzls1)) & _
                                        " WHERE (InvoiceMainID = " & .ValueMatrix(int_temp, 2) & ") AND (InvoiceSubID = " & .ValueMatrix(int_temp, 3) & ")"
                        Cw_DataEnvi.DataConnect.Execute (str_UpdateSql)
                        lng_NotinreasonWasteMoney = lng_NotinreasonWasteMoney + .ValueMatrix(int_temp, Sydz("015", GridStr1(), Szzls1)) '非合理损耗金额总额
                    End If
                Next int_temp
                
                str_sqlTemp = "SELECT SUM(FactReceiptQuan) AS FactReceiptQuanTotal FROM Gy_InOutSub  where " & Me.InOut_FilterCondition
                Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
                Lng_TotalquanInOut = 0
                If rst_temp.RecordCount <> 0 Then
                    Lng_TotalquanInOut = rst_temp.Fields(0)
                End If
                rst_temp.Close
                Set rst_temp = Nothing
                Call ProgressBar_move
                str_sqlTemp = "SELECT ISNULL(SUM(A.TotalMoneyBb - ISNULL(A.NotinreasonWasteMoney, 0)), 0)  " & _
                                      " AS TotalMoneyBb, ISNULL(SUM(A.Quantity * (B.PurInvCon1 / B.PurInvCon2)) " & _
                                      " - SUM(ISNULL(A.NotinreasonWasteQuan, 0) * (B.PurInvCon1 / B.PurInvCon2)) " & _
                                      " - SUM(ISNULL(A.InreasonWasteQuan, 0) * (B.PurInvCon1 / B.PurInvCon2)), 0) " & _
                                      " AS quantity " & _
                               " FROM Cg_InvoiceSub A INNER JOIN " & _
                                      " Gy_Material B ON A.MNumber = B.MNumber " & _
                               " WHERE (A.IsCharge = 0) and " & Me.Invoice_FilterCondition
               Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
               Lng_TotalMoney = 0
               lng_TotalQuantity = 0
               If rst_temp.RecordCount <> 0 Then
                    rst_temp.MoveFirst
                    Lng_TotalMoney = rst_temp.Fields(0).Value
                    lng_TotalQuantity = rst_temp.Fields(1).Value
               End If
               rst_temp.Close
               Set rst_temp = Nothing
                Call ProgressBar_move
               If Lng_TotalquanInOut <> lng_TotalQuantity Then                '结算前的判断
                    Tsxx = "发票或入库单有变化，结算失败!"
                    Call Xtxxts(Tsxx, 0, 1)
                    Fun_HandBalanceExecute = False
                    Exit Function
               End If
               
               lng_WasteMoneyPercentage = 0
               lng_WasteQuantityPercentage = 0
               If Lng_TotalMoney <> 0 Then '求得分摊比率
                    lng_WasteMoneyPercentage = Lng_WasteMoney / Lng_TotalMoney
               End If
               If lng_TotalQuantity <> 0 Then
                    lng_WasteQuantityPercentage = Lng_WasteMoney / lng_TotalQuantity
               End If
               If Me.Option1.Value = True Then '数量分摊
                    For int_temp = .FixedRows To .Rows - 1
                        Call ProgressBar_move
                        If .IsSubtotal(int_temp) = False And .ValueMatrix(int_temp, 1) = 1 Then
                            str_UpdateSql = "UPDATE Cg_InvoiceSub " & _
                                            " Set DistributeCharge = Quantity * (isnull((SELECT TOP 1 (A.PurInvCon1 / A.PurInvCon2) FROM Gy_Material A WHERE Mnumber = Cg_InvoiceSub.Mnumber), 1) * " & lng_WasteQuantityPercentage & ")" & _
                                            " WHERE (InvoiceMainID = " & .ValueMatrix(int_temp, 2) & ") AND (InvoiceSubID = " & .ValueMatrix(int_temp, 3) & ")"
                            Cw_DataEnvi.DataConnect.Execute (str_UpdateSql)
                        End If
                    Next int_temp
               ElseIf Me.Option1.Value = False Then '金额分摊
                    For int_temp = .FixedRows To .Rows - 1
                        Call ProgressBar_move
                        If .IsSubtotal(int_temp) = False And .ValueMatrix(int_temp, 1) = 1 Then
                            str_UpdateSql = "UPDATE Cg_InvoiceSub " & _
                                            " Set DistributeCharge = ((TotalMoneyBb - IsNull(NotinreasonWasteMoney, 0)) * " & lng_WasteMoneyPercentage & ")" & _
                                            " WHERE (InvoiceMainID = " & .ValueMatrix(int_temp, 2) & ") AND (InvoiceSubID = " & .ValueMatrix(int_temp, 3) & ")"
                            Cw_DataEnvi.DataConnect.Execute (str_UpdateSql)
                        End If
                    Next int_temp
               Else
                    Tsxx = "未选择费用的分摊方式!"
                    Call Xtxxts(Tsxx, 0, 1)
                    Fun_HandBalanceExecute = False
                    Exit Function
               End If
                For int_temp = .FixedRows To .Rows - 1   '处理发票差额
                    If .IsSubtotal(int_temp) = False And .ValueMatrix(int_temp, 1) = 1 Then
                    Call ProgressBar_move
                        
                        str_UpdateSql = "UPDATE Cg_InvoiceSub " & _
                                        " Set DistributeCharge = DistributeCharge+ (SELECT " & Lng_WasteMoney & "- ISNULL(SUM(DistributeCharge), 0) AS TatolDistributeCharge " & _
                                                                                   " From Cg_InvoiceSub " & _
                                                                                   " WHERE (IsCharge = 0) " & "and " & Me.Invoice_FilterCondition & ")" & _
                                        " WHERE (InvoiceMainID = " & .ValueMatrix(int_temp, 2) & ") AND (InvoiceSubID = " & .ValueMatrix(int_temp, 3) & ")"
                        Cw_DataEnvi.DataConnect.Execute (str_UpdateSql)
                        Exit For
                    End If
                Next int_temp
           End With
            
              int_MainId = CreatBillID("1210")
              str_BillCode = CreatBillCode("1210", True)
              str_InsertSql = "INSERT INTO Kf_BalanceMain " & _
                            "(BalanceMainId, BillNum, BillCode, SupplierCode, OperType, DeptCode, PersonCode, " & _
                            " Maker, BillDate, KjYear, Period, BanlType) " & _
                            " SELECT TOP 1 " & int_MainId & ",'" & str_BillCode & "', '1210', SupplierCode, '库房结算', ltrim(rtrim(DeptCode)), ltrim(rtrim(PersonCode)),'" & Xtczy & "',convert(datetime,'" & Xtrq & "')," & Xtyear & "," & Xtmm & ",1" & _
                            " FROM Cg_InvoiceMain " & _
                            " where InvoiceMainID in (SELECT A.InvoiceMainID " & _
                                                        " FROM Cg_InvoiceMain A INNER JOIN  Cg_InvoiceSub B ON A.InvoiceMainID = B.InvoiceMainID" & _
                                                        " Where (b.IsCharge = 0) and Cg_InvoiceMain." & Trim(Me.Invoice_FilterCondition) & ")"
              
              Cw_DataEnvi.DataConnect.Execute (str_InsertSql) '生成结算单主表
               Call ProgressBar_move
               str_InsertSql = "SELECT " & int_MainId & " AS MainId, IDENTITY (int, 1, 1) AS SubId, MNumber, isnull" & _
                                          " ((SELECT SUM(isnull(FactReceiptQuan, 0))" & _
                                          " From Gy_InOutSub" & _
                                          " WHERE mnumber = Cg_InvoiceSub.mnumber and  " & Me.InOut_FilterConditionO & "), 0) AS Quantity," & _
                                      " SUM(TotalMoneyBb + ISNULL(DistributeCharge, 0)" & _
                                      " - ISNULL(NotinreasonWasteMoney, 0)) AS EMoney," & _
                                      " SUM(TotalMoneyBb + ISNULL(DistributeCharge, 0)" & _
                                      " - ISNULL(NotinreasonWasteMoney, 0)) / isnull" & _
                                          " ((SELECT SUM(isnull(FactReceiptQuan, 0))" & _
                                          " From Gy_InOutSub" & _
                                          " WHERE mnumber = Cg_InvoiceSub.mnumber and  " & Me.InOut_FilterConditionO & "), 1) AS price," & _
                                     "SUM(isnull(TaxMoneyBb,0)) as TaxMoneyBb, " & _
                                      " SUM(TotalMoneyBb + ISNULL(DistributeCharge, 0)" & _
                                      " - ISNULL(NotinreasonWasteMoney, 0))+SUM(isnull(TaxMoneyBb,0)) as TotalMoney " & _
                                " INTO #remonstrate" & _
                                " From Cg_InvoiceSub" & _
                                " Where (IsCharge = 0) And " & Me.Invoice_FilterCondition & _
                                " GROUP BY MNumber"
               Cw_DataEnvi.DataConnect.Execute ("Kf_Sp_BalanceCreateSub '" & str_InsertSql & "' , 0 ") '生成结算单子表
               Call ProgressBar_move
               str_InsertSql = " INSERT INTO Kf_BalanceRelation " & _
                       " (BalanceMainId, InvoiceMainID, InOutMainId, InOutSubId) " & _
                       " SELECT distinct " & int_MainId & ", InvoiceMainID ,0,0  FROM Cg_InvoiceMain where InvoiceMainID in (SELECT A.InvoiceMainID " & _
                                                        " FROM Cg_InvoiceMain A INNER JOIN  Cg_InvoiceSub B ON A.InvoiceMainID = B.InvoiceMainID" & _
                                                        " Where (b.IsCharge = 0) and A." & Trim(Me.Invoice_FilterCondition) & ")"
               Cw_DataEnvi.DataConnect.Execute (str_InsertSql) '生成发票结算关系
               
                If BanlGrid2.FixedRows <> BanlGrid2.Rows Then
                    For int_temp = BanlGrid2.FixedRows To BanlGrid2.Rows - 1
                        If Trim(BanlGrid2.TextMatrix(int_temp, Sydz("009", GridStr(), Szzls))) = "" Or Trim(BanlGrid2.TextMatrix(int_temp, Sydz("010", GridStr(), Szzls))) = "" Then
                            str_sqlTemp = " SELECT * " & _
                                         " From Kf_BalanceRelation  " & _
                                         " Where (BalanceMainId = " & int_MainId & ") And (InvoiceMainID = " & BanlGrid2.ValueMatrix(int_temp, 2) & ") "
                            Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
                            If rst_temp.RecordCount = 0 Then
                                str_InsertSql = "INSERT INTO Kf_BalanceRelation" & _
                                          " (BalanceMainId, InvoiceMainID, InOutMainId, InOutSubId) " & _
                                    " VALUES (" & int_MainId & "," & BanlGrid2.ValueMatrix(int_temp, 2) & ",0,0)"
                                Cw_DataEnvi.DataConnect.Execute (str_InsertSql) '生成费用发票结算关系
                            End If
                            rst_temp.Close
                            Set rst_temp = Nothing
                        End If
                    Next int_temp
                End If
                              
               Call ProgressBar_move
               str_InsertSql = " INSERT INTO Kf_BalanceRelation " & _
                       " (BalanceMainId, InvoiceMainID, InOutMainId, InOutSubId) " & _
               "SELECT distinct " & int_MainId & ",0,InOutMainId, InOutSubId FROM Gy_InOutSub where " & Me.InOut_FilterCondition
               Cw_DataEnvi.DataConnect.Execute (str_InsertSql) '生成入库单结算关系
               Call ProgressBar_move
               Cw_DataEnvi.DataConnect.Execute ("Kf_Sp_BalanceRelation  " & int_MainId)  '回写入库单及发票
                Call ProgressBar_move
                Lng_TotalMoneyInvoice = 0 '发票总金额除非合理损耗
                str_sqlTemp = "SELECT ISNULL(SUM(TotalMoneyBb),0) " & _
                                   " FROM Cg_InvoiceSub  " & _
                                   " WHERE (IsCharge = 0) and " & Me.Invoice_FilterCondition
                 Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
                 If rst_temp.RecordCount <> 0 Then
                    Lng_TotalMoneyInvoice = rst_temp.Fields(0).Value
                 Else
                    Tsxx = "进行结算的发票有变化,结算失败!"
                    Call Xtxxts(Tsxx, 0, 1)
                    Fun_HandBalanceExecute = False
                    Exit Function
                 End If
                 rst_temp.Close
                 Set rst_temp = Nothing
                 Call ProgressBar_move
                With BanlGrid1
                    For int_temp = .FixedRows To .Rows - 1   '处理入库单差额
                        Call ProgressBar_move
                        If .IsSubtotal(int_temp) = False And .ValueMatrix(int_temp, 1) = 0 Then
                            str_UpdateSql = " Update Gy_InOutSub " & _
                                                " SET EMoney =EMoney+(SELECT " & Lng_TotalMoneyInvoice - lng_NotinreasonWasteMoney - Lng_WasteMoney & " -SUM(ISNULL(EMoney, 0)) " & _
                                                            " From Gy_InOutSub " & _
                                                            " Where " & Me.InOut_FilterCondition & ") " & _
                                                " Where(InOutSubId = " & .ValueMatrix(int_temp, 2) & ") And (InOutMainId = " & .ValueMatrix(int_temp, 3) & ")"
                            Cw_DataEnvi.DataConnect.Execute (str_UpdateSql)
                            Exit For
                        End If
                    Next int_temp
                End With
        
                If Bln_ClrkdKfsc = True Then    '是否生成材料入库单
                    Call ProgressBar_move
                    str_sqlTemp = "SELECT DISTINCT B.WhCode, C.SupplierCode " & _
                                " FROM Kf_BalanceRelation A INNER JOIN " & _
                                      " Gy_InOutMain B ON A.InOutMainId = B.InOutMainId INNER JOIN Kf_BalanceMain C ON A.BalanceMainId = C.BalanceMainId " & _
                                " WHERE (A.BalanceMainId = " & int_MainId & ")"
                    Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
                       Call ProgressBar_move
                       If rst_temp.RecordCount <> 0 Then
                            rst_temp.MoveFirst
                            For int_temp = 1 To rst_temp.RecordCount
                                 Call ProgressBar_move
                                 str_WhCode = Trim("" & rst_temp.Fields("WhCode"))
                                 If Trim(str_WhCode) = "" Then
                                    Tsxx = "入库单中仓库不空,结算失败!"
                                    Call Xtxxts(Tsxx, 0, 1)
                                    Fun_HandBalanceExecute = False
                                    Exit Function
                                 End If
                                 str_SupplierCode = Trim("" & rst_temp.Fields("SupplierCode"))
                                 RKd_MainId = CreatBillID("1212")
                                 
                                 str_InsertSql = " INSERT INTO Gy_InOutMain " & _
                                      " (InOutMainId, BillCode, BillNum, WhCode, InoutFlag, PurTypeCode, OperType,  " & _
                                      " OperbillNum, BillDate, InoutClassCode, TranCompanyCode, TransferWayCode, " & _
                                      " BusNum, DeptCode, PersonCode, CusCode, SupplierCode,   " & _
                                      " ConsignbillNum, Consignbillid,KfChecker , Maker, KjYear, Period,BanlanceId) " & _
                                " SELECT top 1 " & RKd_MainId & " ,'1212', '" & CreatBillCode("1212", True, Xtyear, Xtmm, str_WhCode) & "', WhCode, InoutFlag, PurTypeCode, OperType, " & _
                                      " OperbillNum, convert(datetime,'" & Xtrq & "'), InoutClassCode, TranCompanyCode, TransferWayCode, " & _
                                      " BusNum, DeptCode, PersonCode, CusCode, '" & str_SupplierCode & "', " & _
                                      " ConsignbillNum , Consignbillid, '" & Xtczy & "', '" & Xtczy & "', " & Xtyear & ", " & Xtmm & "," & int_MainId & _
                                " From Gy_InOutMain " & _
                                " Where ltrim(rtrim(WhCode))='" & Trim(str_WhCode) & "' and  InOutMainId  in (SELECT InOutMainId From Kf_BalanceRelation Where (BalanceMainId = " & int_MainId & "))"
                                Cw_DataEnvi.DataConnect.Execute (str_InsertSql) '生成材料入库单主表
                                
                                str_InsertSql = "SELECT IDENTITY (int, 1, 1) AS SubId, " & RKd_MainId & " AS MainId, Gy_InOutSub.MNumber,  " & _
                                                      " sum(Gy_InOutSub.FactReceiptQuan) as FactReceiptQuan, avg(Gy_InOutSub.Price) as Price , sum(Gy_InOutSub.EMoney) as EMoney, " & _
                                                      " sum(Gy_InOutSub.EvaluationMoney) as EvaluationMoney, avg(Gy_InOutSub.PlanPrice) as PlanPrice, sum(Gy_InOutSub.PlanMoney) as PlanMoney " & _
                                                " into #remonstrate " & _
                                                " FROM Gy_InOutSub INNER JOIN " & _
                                                      " Gy_InOutMain ON Gy_InOutSub.InOutMainId = Gy_InOutMain.InOutMainId " & _
                                                " WHERE ( ltrim(rtrim(Gy_InOutMain.WhCode))=''" & Trim(str_WhCode) & "'') AND ((LTRIM(RTRIM(CONVERT(char(20), " & _
                                                      " Gy_InOutSub.InOutMainId))) + ''#'' + LTRIM(RTRIM(CONVERT(char(10), " & _
                                                      " Gy_InOutSub.InOutSubId)))) IN " & _
                                                          " (SELECT ltrim(rtrim(CONVERT(char(20), InoutMainID))) " & _
                                                               " + ''#'' + ltrim(rtrim(CONVERT(char(10), InoutSubId))) " & _
                                                         " From Kf_BalanceRelation " & _
                                                         " WHERE BalanceMainId = " & int_MainId & ")) " & _
                                                " Group by  Gy_InOutSub.MNumber"
                                Cw_DataEnvi.DataConnect.Execute ("Kf_Sp_BalanceCreateSub '" & str_InsertSql & "' ,1 ")  '生成材料入库单子表
                                Call ProgressBar_move
                                rst_temp.MoveNext
                            Next int_temp
                       Else
                            Tsxx = "入库单有变化,结算失败!"
                            Call Xtxxts(Tsxx, 0, 1)
                            Fun_HandBalanceExecute = False
                            Exit Function
                       End If
                    End If
                    
                    '费用发票单独结算
                If BanlGrid2.FixedRows <> BanlGrid2.Rows Then
                    For int_temp = BanlGrid2.FixedRows To BanlGrid2.Rows - 1
                        If Trim(BanlGrid2.TextMatrix(int_temp, Sydz("009", GridStr(), Szzls))) <> "" And Trim(BanlGrid2.TextMatrix(int_temp, Sydz("010", GridStr(), Szzls))) <> "" Then
                            '结算前的判断
                            str_sqlTemp = "SELECT * " & _
                                          " From Cg_InvoiceSub " & _
                                          " Where (IsCharge = 1) And (InvoiceMainID = " & BanlGrid2.ValueMatrix(int_temp, 2) & ") And (InvoiceSubID = " & BanlGrid2.ValueMatrix(int_temp, 3) & ") " & _
                                          " And " & Me.Invoice_FilterCondition
                            Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
                            Call ProgressBar_move
                            If rst_temp.RecordCount = 0 Then
                                Tsxx = "发票有变化，结算失败!"
                                Call Xtxxts(Tsxx, 0, 1)
                                Fun_HandBalanceExecute = False
                                Exit Function
                            End If
                             rst_temp.Close
                             Set rst_temp = Nothing
    
                            str_WhCode = Trim(BanlGrid2.TextMatrix(int_temp, 4))
                            str_MNumber = Trim(BanlGrid2.TextMatrix(int_temp, 5))
                            
                            int_MainId = CreatBillID("1210")
                            str_BillCode = CreatBillCode("1210", True)
                            
                            str_InsertSql = "INSERT INTO Kf_BalanceRelation" & _
                                      " (BalanceMainId, InvoiceMainID, InOutMainId, InOutSubId) " & _
                                " VALUES (" & int_MainId & "," & BanlGrid2.ValueMatrix(int_temp, 2) & ",0,0)"
                            Cw_DataEnvi.DataConnect.Execute (str_InsertSql) '生成结算发票关系
                            
                            str_InsertSql = "INSERT INTO Kf_BalanceMain " & _
                                          "(BalanceMainId, BillNum, BillCode, SupplierCode, OperType, DeptCode, PersonCode, " & _
                                          " Maker, BillDate, KjYear, Period, BanlType) " & _
                                          " (SELECT TOP 1 " & int_MainId & ",'" & str_BillCode & "', '1210', SupplierCode, '库房结算', ltrim(rtrim(DeptCode)), ltrim(rtrim(PersonCode)),'" & Xtczy & "',convert(datetime,'" & Xtrq & "')," & Xtyear & "," & Xtmm & ",1" & _
                                          " FROM Cg_InvoiceMain  where InvoiceMainID =" & BanlGrid2.ValueMatrix(int_temp, 2) & ")"
                            Cw_DataEnvi.DataConnect.Execute (str_InsertSql) '生成结算单主表
                            Call ProgressBar_move
                            Cw_DataEnvi.DataConnect.Execute ("Kf_Sp_WasteBalanceRelation  " & int_MainId & ",'" & str_WhCode & "','" & str_MNumber & "'," & BanlGrid2.ValueMatrix(int_temp, 3)) '生成结算单子表
                            Call ProgressBar_move
                            If Bln_ClrkdKfsc = True Then    '是否生成费用材料入库单
                                     str_WhCode = Trim(BanlGrid2.TextMatrix(int_temp, 4))
                                     If Trim(str_WhCode) = "" Then
                                        Tsxx = "单独结算的费用发票仓库不能为空!"
                                        Call Xtxxts(Tsxx, 0, 1)
                                        Fun_HandBalanceExecute = False
                                        Exit Function
                                     End If
                                     RKd_MainId = CreatBillID("1212")
                                     RKd_MainCode = CreatBillCode("1212", True, Xtyear, Xtmm, str_WhCode)
                                     Cw_DataEnvi.DataConnect.Execute ("Kf_Sp_WasteRkd " & int_MainId & "," & RKd_MainId & ",'" & str_WhCode & "','" & RKd_MainCode & "'")
                            End If
                        End If
                    Call ProgressBar_move
                    Next int_temp
               End If
        Case "3"
             ProgressBar1.Max = (BanlGrid1.Rows - 1) * 10 + 10
            If BanlGrid2.FixedRows <> BanlGrid2.Rows Then
                For int_temp = BanlGrid2.FixedRows To BanlGrid2.Rows - 1
                    If Trim(BanlGrid2.TextMatrix(int_temp, Sydz("009", GridStr(), Szzls))) <> "" And Trim(BanlGrid2.TextMatrix(int_temp, Sydz("010", GridStr(), Szzls))) <> "" Then
                        Call ProgressBar_move
                        '结算前的判断
                        str_sqlTemp = "SELECT * " & _
                                      " From Cg_InvoiceSub " & _
                                      " Where (IsCharge = 1) And (InvoiceMainID = " & BanlGrid2.ValueMatrix(int_temp, 2) & ") And (InvoiceSubID = " & BanlGrid2.ValueMatrix(int_temp, 3) & ") " & _
                                      " And " & Me.Invoice_FilterCondition
                        Set rst_temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
                        If rst_temp.RecordCount = 0 Then
                            Tsxx = "发票有变化，结算失败!"
                            Call Xtxxts(Tsxx, 0, 1)
                            Fun_HandBalanceExecute = False
                            Exit Function
                        End If
                         rst_temp.Close
                         Set rst_temp = Nothing
                        str_WhCode = Trim(BanlGrid2.TextMatrix(int_temp, 4))
                        str_MNumber = Trim(BanlGrid2.TextMatrix(int_temp, 5))
                        
                        int_MainId = CreatBillID("1210")
                        str_BillCode = CreatBillCode("1210", True)
                        
                        str_InsertSql = "INSERT INTO Kf_BalanceRelation" & _
                                  " (BalanceMainId, InvoiceMainID, InOutMainId, InOutSubId) " & _
                            " VALUES (" & int_MainId & "," & BanlGrid2.ValueMatrix(int_temp, 2) & ",0,0)"
                        Cw_DataEnvi.DataConnect.Execute (str_InsertSql) '生成结算发票关系
                        
                        str_InsertSql = "INSERT INTO Kf_BalanceMain " & _
                                      "(BalanceMainId, BillNum, BillCode, SupplierCode, OperType, DeptCode, PersonCode, " & _
                                      " Maker, BillDate, KjYear, Period, BanlType) " & _
                                      " (SELECT TOP 1 " & int_MainId & ",'" & str_BillCode & "', '1210', SupplierCode, '库房结算', ltrim(rtrim(DeptCode)), ltrim(rtrim(PersonCode)),'" & Xtczy & "',convert(datetime,'" & Xtrq & "')," & Xtyear & "," & Xtmm & ",1" & _
                                      " FROM Cg_InvoiceMain  where InvoiceMainID =" & BanlGrid2.ValueMatrix(int_temp, 2) & ")"
                        Cw_DataEnvi.DataConnect.Execute (str_InsertSql) '生成结算单主表
                        Call ProgressBar_move
                        Cw_DataEnvi.DataConnect.Execute ("Kf_Sp_WasteBalanceRelation  " & int_MainId & ",'" & str_WhCode & "','" & str_MNumber & "'," & BanlGrid2.ValueMatrix(int_temp, 3)) '生成结算单子表
                        Call ProgressBar_move
                        If Bln_ClrkdKfsc = True Then    '是否生成费用材料入库单
                                 str_WhCode = Trim(BanlGrid2.TextMatrix(int_temp, 4))
                                 If Trim(str_WhCode) = "" Then
                                    Tsxx = "单独结算的费用发票仓库不能为空!"
                                    Call Xtxxts(Tsxx, 0, 1)
                                    Fun_HandBalanceExecute = False
                                    Exit Function
                                 End If
                                 RKd_MainId = CreatBillID("1212")
                                 RKd_MainCode = CreatBillCode("1212", True, Xtyear, Xtmm, str_WhCode)
                                 Cw_DataEnvi.DataConnect.Execute ("Kf_Sp_WasteRkd " & int_MainId & "," & RKd_MainId & ",'" & str_WhCode & "','" & RKd_MainCode & "'")
                        End If
                    End If
                Call ProgressBar_move
                Next int_temp
            End If
    End Select
    Fun_HandBalanceExecute = True
    Exit Function
errExecute:
    Fun_HandBalanceExecute = False
End Function
Private Sub ProgressBar_move()
    If ProgressBar1.Value = 0 Then
        ProgressBar1.Visible = True
        ProgressBar1.Value = ProgressBar1.Value + 5
    ElseIf ProgressBar1.Value < ProgressBar1.Max - 5 Then
        ProgressBar1.Value = ProgressBar1.Value + 5
    Else
      ProgressBar1.Value = ProgressBar1.Max
      ProgressBar1.Visible = False
    End If
End Sub
Public Property Get Invoice_FilterCondition() As String
  Invoice_FilterCondition = str_InvoiceFilterCondition
End Property
Public Property Let Invoice_FilterCondition(ByVal vNewValue As String)
  str_InvoiceFilterCondition = vNewValue
End Property
Public Property Get InOut_FilterCondition() As String
  InOut_FilterCondition = str_InOutFilterCondition
End Property
Public Property Let InOut_FilterCondition(ByVal vNewValue As String)
  str_InOutFilterCondition = vNewValue
End Property
Public Property Get InOut_FilterConditionO() As String
  InOut_FilterConditionO = str_InOutFilterConditionOther
End Property
Public Property Let InOut_FilterConditionO(ByVal vNewValue As String)
  str_InOutFilterConditionOther = vNewValue
End Property
Private Sub check_num_for_grid1(mgrid As VSFlexGrid, mkeyascii As Integer)      '文本框录入整数值(负)限制
  If Not ((mkeyascii >= Asc("0") And Chr(mkeyascii) <= "9") Or (Chr(mkeyascii) = "." And InStr(1, mgrid.EditText, ".") = 0) Or Chr(mkeyascii) = vbKeyBack) Then
     mkeyascii = 0
  End If
End Sub
Private Sub check_num_for_grid(mgrid As VSFlexGrid, mkeyascii As Integer)      '文本框录入整数值(负)限制
  If Not ((mkeyascii >= Asc("0") And mkeyascii <= Asc("9")) Or (Chr(mkeyascii) = "." And InStr(1, mgrid.EditText, ".") = 0) Or mkeyascii = vbKeyBack Or (Chr(mkeyascii) = "-" And mgrid.EditSelStart = 0)) Then
     mkeyascii = 0
  End If
End Sub
Private Function FillCombo1(Combote As ComboBox, Lbkbmte As String, Dwnr As String, AddType As Integer) As String    '填充列表框并定位
    '函数参数：列表框,列表框分组编码,定位内容,填充类型(0-无空记录  1-有空记录(1个空格) )
    Dim Lbknrrec As ADODB.Recordset
  
    '填充列表框内容
    Set Lbknrrec = Cw_DataEnvi.DataConnect.Execute("select * from xt_combolist where combo_code='" + Trim(Lbkbmte) + "' order by item_index")
    Combote.Clear
    If AddType = 1 Then
        Combote.AddItem " "
    End If
    With Lbknrrec
        Do While Not .EOF
            Combote.AddItem Trim(.Fields("item_index")) & "-" & Trim(.Fields("item_content"))
            .MoveNext
        Loop
    End With
    
    '定位列表框内容
    With Combote
        For jsqte = .ListCount - 1 To 0 Step -1
            If Dwnr = Trim(.List(jsqte)) Then
                Exit For
            End If
        Next jsqte
        If jsqte <> -1 Then
            Combote.Text = .List(jsqte)
        Else
            If .ListCount <> 0 Then
                .Text = .List(0)
            End If
        End If
    End With
End Function

						