企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{65A39231-6133-11D1-BAA2-444553540000}#1.0#0"; "vslight6.OCX"
Object = "{C5DE3F80-3376-11D2-BAA4-04F205C10000}#1.0#0"; "Vsflex6d.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form PZ_FrmNoteChList 
   Caption         =   "单据列表"
   ClientHeight    =   8595
   ClientLeft      =   315
   ClientTop       =   390
   ClientWidth     =   11820
   HelpContextID   =   5001
   Icon            =   "制作凭证_应收票据变动单据列表.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   8595
   ScaleWidth      =   11820
   WindowState     =   2  'Maximized
   Begin MSComctlLib.Toolbar GsToolbar 
      Height          =   540
      Left            =   9330
      TabIndex        =   3
      Top             =   30
      Width           =   2475
      _ExtentX        =   4366
      _ExtentY        =   953
      ButtonWidth     =   1455
      ButtonHeight    =   953
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList2"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   3
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "保存格式"
            Key             =   "bcgs"
            ImageKey        =   "bcgs"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "默认列宽"
            Key             =   "hfmrgs"
            ImageKey        =   "mrlk"
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "显示项目"
            Key             =   "szxsxm"
            ImageKey        =   "xsxm"
         EndProperty
      EndProperty
   End
   Begin VB.PictureBox Pic_Title 
      Height          =   1125
      Left            =   0
      Picture         =   "制作凭证_应收票据变动单据列表.frx":1042
      ScaleHeight     =   1065
      ScaleWidth      =   11715
      TabIndex        =   1
      Top             =   570
      Width           =   11775
      Begin MSComctlLib.ImageCombo Imagbo_Vouch 
         Height          =   330
         Left            =   1230
         TabIndex        =   7
         Top             =   720
         Width           =   1515
         _ExtentX        =   2672
         _ExtentY        =   582
         _Version        =   393216
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         Text            =   "Imagbo_Vouch"
      End
      Begin MSComctlLib.ImageList ImageList1 
         Left            =   8370
         Top             =   0
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   16
         ImageHeight     =   16
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   10
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":35106
               Key             =   "bz"
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":354A0
               Key             =   "tc"
            EndProperty
            BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3583A
               Key             =   "bcgs"
            EndProperty
            BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":35BD4
               Key             =   "mrlk"
            EndProperty
            BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":35F6E
               Key             =   "xsxm"
            EndProperty
            BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":36308
               Key             =   "allcancel"
            EndProperty
            BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":366A2
               Key             =   "unit"
            EndProperty
            BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":36A3C
               Key             =   "allselect"
            EndProperty
            BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":36DD6
               Key             =   "filter"
            EndProperty
            BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":37170
               Key             =   "run"
            EndProperty
         EndProperty
      End
      Begin VB.Label LabDate 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "labdate"
         Height          =   195
         Left            =   4350
         TabIndex        =   8
         Top             =   780
         Width           =   525
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "日期:"
         Height          =   195
         Left            =   3810
         TabIndex        =   6
         Top             =   780
         Width           =   765
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "凭证类别:"
         Height          =   195
         Left            =   360
         TabIndex        =   5
         Top             =   780
         Width           =   765
      End
      Begin VB.Label Lab_Title 
         AutoSize        =   -1  'True
         BackColor       =   &H80000018&
         BackStyle       =   0  'Transparent
         Caption         =   "单据列表"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   240
         Index           =   4
         Left            =   510
         TabIndex        =   2
         Top             =   210
         Width           =   1020
      End
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   8970
      Top             =   630
   End
   Begin VSFlex6DAOCtl.vsFlexGrid CxbbGrid 
      Height          =   7305
      Left            =   30
      TabIndex        =   0
      Top             =   1710
      Width           =   11775
      _ExtentX        =   20770
      _ExtentY        =   12885
      _ConvInfo       =   1
      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       =   16777215
      ForeColor       =   -2147483640
      BackColorFixed  =   13826538
      ForeColorFixed  =   -2147483630
      BackColorSel    =   -2147483635
      ForeColorSel    =   -2147483634
      BackColorBkg    =   -2147483636
      BackColorAlternate=   16777215
      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            =   50
      Cols            =   10
      FixedRows       =   1
      FixedCols       =   1
      RowHeightMin    =   0
      RowHeightMax    =   0
      ColWidthMin     =   0
      ColWidthMax     =   0
      ExtendLastCol   =   0   'False
      FormatString    =   ""
      ScrollTrack     =   0   'False
      ScrollBars      =   3
      ScrollTips      =   0   'False
      MergeCells      =   0
      MergeCompare    =   0
      AutoResize      =   -1  'True
      AutoSizeMode    =   0
      AutoSearch      =   0
      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   'False
      ShowComboButton =   -1  'True
      WordWrap        =   0   'False
      TextStyle       =   0
      TextStyleFixed  =   0
      OleDragMode     =   0
      OleDropMode     =   0
      DataMode        =   0
      VirtualData     =   -1  'True
      Begin MSComctlLib.ImageList ImageList2 
         Left            =   0
         Top             =   0
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   16
         ImageHeight     =   16
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   40
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3750A
               Key             =   "sz"
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":378A4
               Key             =   "dy"
            EndProperty
            BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":37C3E
               Key             =   "yl"
            EndProperty
            BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":37FD8
               Key             =   "xg"
            EndProperty
            BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":38372
               Key             =   "zh"
            EndProperty
            BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3870C
               Key             =   "sh"
            EndProperty
            BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":38AA6
               Key             =   "bc"
            EndProperty
            BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":38E40
               Key             =   "fq"
            EndProperty
            BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":391DA
               Key             =   "bz"
            EndProperty
            BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":39574
               Key             =   "tc"
            EndProperty
            BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3990E
               Key             =   "bcgs"
            EndProperty
            BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":39CA8
               Key             =   "mrlk"
            EndProperty
            BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3A042
               Key             =   "xsxm"
            EndProperty
            BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3A3DC
               Key             =   "first"
            EndProperty
            BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3A776
               Key             =   "prev"
            EndProperty
            BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3AB10
               Key             =   "next"
            EndProperty
            BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3AEAA
               Key             =   "last"
            EndProperty
            BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3B244
               Key             =   "xx"
            EndProperty
            BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3B5DE
               Key             =   "define"
            EndProperty
            BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3B978
               Key             =   "exec"
            EndProperty
            BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3BD12
               Key             =   "xz"
            EndProperty
            BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3C0AC
               Key             =   "sc"
            EndProperty
            BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3C446
               Key             =   "sx"
            EndProperty
            BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3C7E0
               Key             =   "cx"
            EndProperty
            BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3CB7A
               Key             =   "zd"
            EndProperty
            BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3CF14
               Key             =   "dz"
            EndProperty
            BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3D2AE
               Key             =   "ph"
            EndProperty
            BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3D648
               Key             =   "fz"
            EndProperty
            BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3D9E2
               Key             =   "dw"
            EndProperty
            BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3DD7C
               Key             =   "hf"
            EndProperty
            BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3E116
               Key             =   "pz"
            EndProperty
            BeginProperty ListImage32 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3E4B0
               Key             =   "check"
            EndProperty
            BeginProperty ListImage33 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3E84A
               Key             =   "qs"
            EndProperty
            BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3EBE4
               Key             =   "fullcheck"
            EndProperty
            BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3EF7E
               Key             =   "qq"
            EndProperty
            BeginProperty ListImage36 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3F318
               Key             =   "bcw"
            EndProperty
            BeginProperty ListImage37 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3F6B2
               Key             =   "ye"
            EndProperty
            BeginProperty ListImage38 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3FA4C
               Key             =   ""
            EndProperty
            BeginProperty ListImage39 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":3FDE6
               Key             =   "frist"
            EndProperty
            BeginProperty ListImage40 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "制作凭证_应收票据变动单据列表.frx":40180
               Key             =   "dj"
            EndProperty
         EndProperty
      End
   End
   Begin MSComctlLib.Toolbar SzToolbar 
      Align           =   1  'Align Top
      Height          =   570
      Left            =   0
      TabIndex        =   4
      Top             =   0
      Width           =   11820
      _ExtentX        =   20849
      _ExtentY        =   1005
      ButtonWidth     =   820
      ButtonHeight    =   953
      AllowCustomize  =   0   'False
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   10
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "过滤"
            Key             =   "filter"
            ImageKey        =   "filter"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "全选"
            Key             =   "allselect"
            ImageKey        =   "allselect"
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "全消"
            Key             =   "allcancel"
            ImageKey        =   "allcancel"
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "合并"
            Key             =   "unit"
            ImageKey        =   "unit"
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "凭证"
            Key             =   "run"
            ImageKey        =   "run"
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "帮助"
            Key             =   "bz"
            ImageKey        =   "bz"
         EndProperty
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "fh"
            ImageKey        =   "tc"
         EndProperty
      EndProperty
      BorderStyle     =   1
   End
End
Attribute VB_Name = "PZ_FrmNoteChList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************************************
'*    模 块 名 称 :应收票据变动制作凭证
'*    功 能 描 述 :
'*    程序员姓名  :姜冬梅
'*    最后修改人  :姜冬梅
'*    最后修改时间:2001/12/26
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'**************************************************************************
Dim ReportTitle As String                '报表主标题
Dim Str_QueryCondi As String             '用户录入查询条件
Dim Jsq_Max As Long                      '网格的最大记录数
Dim OperationNum    As Long              '本次转帐操作批号
Dim TranJsq As Integer                   '本批选择的网格记录个数
Dim FiltListId() As Long                 '需要转帐的明细帐AccListID数组
Dim TranVouchClass() As String           '转帐凭证类别数组
Dim VouchModelType() As String           '凭证模板类型
Dim TranNoteCode() As String             '应收票据数据
Dim VouchRow As Long                     '每张凭证内分录的ID值
Dim Bln_DeleteFlag As Boolean            '转帐后是否删除临时表
Dim UnitFlag As Boolean                  '合并生成凭证标志
Dim ArApFlag As String                   '应收应付标志
Dim Int_Kjyear As Integer                '会计年
Dim Int_Period As Integer                '会计月
Dim MenuBillCode_Con As String           '转帐单据类型条件
Dim MenuBillCode As String               '菜单选中的单据类型
Dim YbJe As Double                       '原币金额
Dim BbJe As Double                       '本币金额
Dim AccRate As Double                    '记帐汇率
Dim BankBillNo As String                 '银行票号
Dim SsCode As String                     '结算方式
Dim ForeignCurrCode As String            '外币编码
Dim BillDate As Date                     '单据日期
Dim PersonName As String                 '经办人名称
Dim CustName As String                   '客户名称
Dim SuppName As String                   '供应商名称
Dim Rec As String                        '单据数据表名变量
Dim RecBillId As String                  '单据数据表ID
'以下为固定使用变量
Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
Dim GridCode As String                   '显示网格网格代码
Dim GridInf() As Variant                 '整个网格设置信息
Dim Tsxx As String                       '系统提示信息
Dim Qslz As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                      '网格数据行高度
Dim Sfxshjwg As Boolean                  '是否显示合计网格
Dim GridBoolean() As Boolean             '网格列信息(布尔型)
Dim GridStr()  As String                 '网格列信息(字符型)
Dim GridInt() As Integer                 '网格列信息(整型)
Dim Szzls As Integer                     '数组总列数(网格列数-1)
Private Sub CxbbGrid_DblClick()
    If CxbbGrid.Row > CxbbGrid.FixedRows - 1 And GridStr(CxbbGrid.Col, 1) = "001" Then
        If CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)) = "" Then
            If CxbbGrid.TextMatrix(CxbbGrid.Row, 1) = True Then
                 Tsxx = "该单据已制作凭证！"
                 Call Xtxxts(Tsxx, 0, 4)
                 Exit Sub
            End If
            If Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 2)) <> 0 And Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("010", GridStr(), Szzls))) = "" Then
                 Tsxx = "该变动单对应的其它应收单没有审核！"
                 Call Xtxxts(Tsxx, 0, 4)
                 Exit Sub
            End If
            If Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 3)) <> 0 And Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("010", GridStr(), Szzls))) = "" Then
                 Tsxx = "该变动单对应的其它应付单没有审核！"
                 Call Xtxxts(Tsxx, 0, 4)
                 Exit Sub
            End If
            
            CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)) = "√"
        Else
            CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)) = ""
        End If
    End If
End Sub
Private Sub Form_Resize()                '根据窗体大小来调整网格,标题栏大小(Fixed)
    
    On Error Resume Next
    
    With CxbbGrid
        .Width = Me.Width - 160
        .Height = Me.Height - .Top - 400
    End With
    
    With Pic_Title
        .Width = Me.Width - 160
    End With
    
    GsToolbar.Left = Me.Width - GsToolbar.Width - 140
End Sub
Private Sub Form_Load()                                                   '窗体装入
  
    '调入打印页面设置窗体
  
    '调整标题栏及网格、格式工具条位置(Fixed)
    Pic_Title.Left = 40
    Pic_Title.Top = SzToolbar.Top + SzToolbar.Height - 10
    CxbbGrid.Left = Pic_Title.Left
    CxbbGrid.Top = Pic_Title.Top + Pic_Title.Height + 20
 
    '调 入 网 格(Fixed)
    GridCode = "Ar_NoteChList"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
    
    MenuBillCode = ItemType
    ArApFlag = "AR"             '应收系统标志
    
 
    Call Start                  '初始化凭证类型、制单日期
End Sub
Private Sub Form_Unload(Cancel As Integer)                                  '窗体卸载
    '卸载条件窗体
    PZ_FrmNoteChFilter.UnloadCheck.Value = 1
    Unload PZ_FrmNoteChFilter
End Sub
Private Sub CxbbGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
End Sub
Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)       '网格格式调整(Fixed)
    
    Select Case Button.Key
        Case "bcgs"                                          '保存表格格式
            Call Bcwggs(CxbbGrid, GridCode, GridStr())
        Case "hfmrgs"                                        '恢复默认格式
            Call Hfmrgs(CxbbGrid, GridCode, GridStr())
        Case "szxsxm"                                        '设置显示项目
            Call Szxsxm(CxbbGrid, GridCode)
    End Select
End Sub
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
        Case "filter"                                        '过滤
            PZ_FrmNoteChFilter.Show 1
        Case "bill"                                          '单 据
            Call CxbbGrid_DblClick
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
        Case "run"                                           '生成凭证
            Call Sub_Run
        Case "allselect"                                     '全选
            Call Sub_AllSelect
        Case "allcancel"                                     '全弃
            Call Sub_AllCancel
        Case "unit"                                          '合并
            Call Sub_Unit
    End Select
End Sub
Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    
    Timer1.Enabled = False
    Xt_Wait.Show
    Xt_Wait.Refresh
   
    '加快显示速度
    CxbbGrid.Redraw = False
 
    '生成查询结果
    Call Sub_Query(0)
   
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide
End Sub
Private Sub Sub_Query(Int_QueryType As Integer)                                     '生成查询结果(Define)
    
    '过程参数:Int_QueryType 0-"点确定按钮"查询  1-"刷新"查询
    Dim Rec_Query As New ADODB.Recordset        '查询结果动态集
    Dim Coljsq As Long                          '网格列计数器
    Dim jsqte As Long                           '临时动态计数器
    Dim State As String                         '票据状态
    '以下为自定义部分[
 
    If Int_QueryType = 0 Then   '0-"点确定按钮"查询
        With PZ_FrmNoteChFilter
         
            '生成查询条件
            Str_QueryCondi = " where 1=1  and " & MenuBillCode_Con
         
            For jsqte = 1 To 4
                Select Case jsqte
                    Case 1  '单据日期(起,止）
                        If Trim(.LrText(0).Text) <> "" And Trim(.LrText(1).Text) <> "" Then
                            If Trim(.LrText(0).Text) = Trim(.LrText(1)) Then
                                Str_QueryCondi = Str_QueryCondi & " and CloseDate = '" & CDate(.LrText(0).Text) & "'"
                            Else
                                Str_QueryCondi = Str_QueryCondi & " and CloseDate >= '" & CDate(.LrText(0).Text) & "'"
                                Str_QueryCondi = Str_QueryCondi & " and CloseDate <= '" & CDate(.LrText(1).Text) & "'"
                            End If
                        End If
                        If Trim(.LrText(0).Text) <> "" And Trim(.LrText(1).Text) = "" Then
                            Str_QueryCondi = Str_QueryCondi & " and CloseDate >= '" & CDate(.LrText(0).Text) & "'"
                        End If
                        If Trim(.LrText(0).Text) = "" And Trim(.LrText(1).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and CloseDate <= '" & CDate(.LrText(1).Text) & "'"
                        End If
                    Case 2  '客户
                        If Trim(.LrText(2).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " and PsCode = '" & Trim(.LrText(2).Tag) & "'"
                        End If
                    Case 3  '币别
                        If Trim(.LrText(3).Text) <> "" Then
                            Str_QueryCondi = Str_QueryCondi & " And ForeignCurrCode='" & Trim(.LrText(3).Tag) & "'"
                        End If
                    Case 4 '凭证状态
                        If .Opt_Check(1).Value = True Then '已制凭证
                            Str_QueryCondi = Str_QueryCondi & " And  IfBuildVouch='1' "
                        End If
                        If .Opt_Check(2).Value = True Then  '未制凭证
                            Str_QueryCondi = Str_QueryCondi & " And IfBuildVouch='0' "
                        End If
                        
                End Select
            Next jsqte
        End With
    Else
        '1-"刷新"查询
        If Str_QueryCondi = "" Then
            Str_QueryCondi = " where 1=2 "
        End If
    End If
    
    Sqlstr = "SELECT * FROM Ar_v_NoteClose " & Str_QueryCondi & "  Order By NoteCloseID"
    
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Rec_Query
        CxbbGrid.Rows = CxbbGrid.FixedRows
        jsqte = CxbbGrid.FixedRows
        Do While Not .EOF
            CxbbGrid.AddItem ""
            
            '[>>自定义填充内容
            CxbbGrid.TextMatrix(jsqte, 0) = .Fields("NoteCloseID")                  '变动明细记录ID
            CxbbGrid.TextMatrix(jsqte, 1) = .Fields("IfBuildVouch")                 '是否已经生成凭证
            CxbbGrid.TextMatrix(jsqte, 2) = Trim(.Fields("BillIDAR") & "")          '应收单记录ID
            CxbbGrid.TextMatrix(jsqte, 3) = Trim(.Fields("BillIDAP") & "")          '应付单记录ID
            CxbbGrid.TextMatrix(jsqte, 4) = Trim(.Fields("VouchModel") & "")        '转帐凭证模板类型
            CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = ""                                            '选中
            CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Format(.Fields("CloseDate"), "yyyy-mm-dd")    '单据日期
            CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("BillItemCode") & "")                 '票据类型
            CxbbGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("BillItemName") & "")                 '票据类型
            CxbbGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("NoteCode") & "")                '单据编号
            CxbbGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("CusName") & "")                 '客户名称
            CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("ForeignCurrName") & "")         '币别名称
            YbJe = Val(Trim(.Fields("YbCash") & ""))               '原币金额
            BbJe = Val(Trim(.Fields("BbCash") & ""))               '本币金额
            YbExpense = Val(Trim(.Fields("YbExpense") & ""))       '原币费用
            BbExpense = Val(Trim(.Fields("BbExpense") & ""))       '本币费用
            CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = YbJe
            CxbbGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = BbJe
            If Trim(.Fields("CheckerAr") & "") = "" Then
                CxbbGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("CheckerAp") & "")             '该变动单对应的应收单或应付单已经审核后的审核人。
            Else
                CxbbGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("CheckerAr") & "")             '该变动单对应的应收单或应付单已经审核后的审核人。
            End If
            CxbbGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("DeptName") & "")                  '部门名称
            CxbbGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("PersonName") & "")                '经办人
            CxbbGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("Digest") & "")                    '摘要
            CxbbGrid.TextMatrix(jsqte, Sydz("014", GridStr(), Szzls)) = Trim(.Fields("SupplierName") & "")              '供应商名称
            If Trim(.Fields("VouchNo") & "") = "" Or Trim(.Fields("IfBuildVouch") & "") = False Then                    '凭证类别和凭证号
                CxbbGrid.TextMatrix(jsqte, Sydz("015", GridStr(), Szzls)) = ""
            Else
                CxbbGrid.TextMatrix(jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("VouchClassCode") & "") & "-" & Trim(.Fields("VouchNo") & "")
            End If
            CxbbGrid.TextMatrix(jsqte, Sydz("016", GridStr(), Szzls)) = YbFy
            CxbbGrid.TextMatrix(jsqte, Sydz("017", GridStr(), Szzls)) = BbFy
            CxbbGrid.TextMatrix(jsqte, Sydz("018", GridStr(), Szzls)) = Trim(.Fields("TranVouchClassCode") & "")
            
            '<<]
            
            '设置数据行高度(Fixed)
            CxbbGrid.RowHeight(jsqte) = Sjhgd
            
            '动态集指针加1,同时将计数器加1(Fixed)
            .MoveNext
            jsqte = jsqte + 1
        Loop
        Jsq_Max = jsqte - 1
    End With
    
    ']以上为用户自定义部分
End Sub
Private Function Tran_Pd() As Boolean            '转帐之前的判断
    Dim jsq As Long             '临时计数器
    
    Tran_Pd = False
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Function
    End If
    
    '会计期间
    '判断用户所选业务日期与当前会计期间是否一致
    Sqlstr = "Select Top 1 * FROM Gy_Kjrlb Where ArJzbz=0 Order By Kjyear,Period"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If Not .EOF Then
            If Not (Xtrq >= .Fields("Qsrq") And Xtrq <= .Fields("Zzrq")) Then
                Tsxx = "业务日期应在当前会计期间范围内!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            Else
                Int_Kjyear = .Fields("Kjyear")
                Int_Period = .Fields("Period")
            End If
        Else
            Tsxx = "业务日期会计期间已结帐完毕!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
    End With
    
    
    '将每个转帐过程编号赋值到FiltListId（）数组中，
    ReDim FiltListId(1)         '变动单ID
    ReDim TranVouchClass(1)     '将每个转帐过程的凭证类别放到数组TranVouchClass中
    ReDim VouchModelType(1)     '凭证模板
    ReDim TranNoteCode(1)       '应收票据编码
    TranJsq = 0
        
    '将需要制作凭证的记录的AccListId保存到FiltListId中。
    '将产生的凭证张数，保存在TranJsq中。
    
    For jsq = CxbbGrid.FixedRows To Jsq_Max
        If CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) <> "" Then
            If CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "1" Then   '若生成的凭证需要合并
                UnitFlag = True
            Else
                UnitFlag = False
            End If
            If TranJsq = 0 Then
                
                TranJsq = TranJsq + 1
            Else
                If TranJsq > 1 Then
                    ReDim Preserve TranVouchClass(UBound(TranVouchClass) + 1)
                    ReDim Preserve FiltListId(UBound(FiltListId) + 1)
                    ReDim Preserve VouchModelType(UBound(VouchModelType) + 1)
                    ReDim Preserve TranNoteCode(UBound(TranNoteCode) + 1)
                    
                End If
            End If
            FiltListId(TranJsq) = CxbbGrid.TextMatrix(jsq, 0)                                 '变动单ID
            TranVouchClass(TranJsq) = CxbbGrid.TextMatrix(jsq, Sydz("018", GridStr(), Szzls)) '凭证类别编码
            VouchModelType(TranJsq) = CxbbGrid.TextMatrix(jsq, 4)                             '凭证模板类型
            TranNoteCode(TranJsq) = CxbbGrid.TextMatrix(jsq, Sydz("005", GridStr(), Szzls))   '应收票据编码
            
            TranJsq = TranJsq + 1
        End If
    Next jsq
    
    '本次需要制作凭证的有效记录个数
    TranJsq = TranJsq - 1
    If TranJsq <= 0 Then
        Tsxx = "请选择单据!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
    End If
    
   
    OperationNum = CreatBillID("0102")                     '本次制作凭证的操作批号
    Tran_Pd = True
End Function
Private Sub Sub_Run() '生成凭证
    Dim jsq As Long                      '临时计数器
    Dim lng_OperationNum As Long            '临时凭证ID
    Bln_DeleteFlag = True
    
    '判断有效性
    If Tran_Pd = False Then
        Exit Sub
    End If
    
   '【写临时凭证
    On Error GoTo ERR1
    Cw_DataEnvi.DataConnect.BeginTrans
    Select Case UnitFlag
        Case True           '合并为1张凭证
             lng_OperationNum = CreatBillID("0102")                      '临时凭证ID号
             
             '写临时凭证主表
             VouchRow = 1
             Call Save_TempPz_Main(TranVouchClass(1), OperationNum, OperationNum, lng_OperationNum)  '参数是凭证类别，行号，批号，凭证ID,对合并生成凭证时，行号没有意义
             
             '根据应收明细帐记录，写临时凭证子表
             For jsq = 1 To TranJsq
                 Call Save_TempPz_Ass_Pre(lng_OperationNum, FiltListId(jsq), VouchModelType(jsq), jsq, TranNoteCode(jsq))
             Next jsq
        Case False           '不合并
             For jsq = 1 To TranJsq
                 lng_OperationNum = CreatBillID("0102")                  '临时凭证ID号
             
                 '写临时凭证主表
                 VouchRow = 1
                 Call Save_TempPz_Main(TranVouchClass(jsq), FiltListId(jsq), OperationNum, lng_OperationNum)  '参数是凭证类别，行号，批号，将来凭证形成ID
             
                 '根据应收明细帐记录，写临时凭证子表
                 Call Save_TempPz_Ass_Pre(lng_OperationNum, FiltListId(jsq), VouchModelType(jsq), jsq, TranNoteCode(jsq))
             Next jsq
    End Select
    Cw_DataEnvi.DataConnect.CommitTrans
    '记录此次转帐的批号，做为凭证窗体调用的参数
    
    '】以上是写临时凭证记录
    
    AutoTran_PzFrm.OperationNumPz = OperationNum       '传递此次转帐批号
    
    AutoTran_PzFrm.Show 1  '临时转帐凭证窗体
    
    
    Call WriteVouchId
    Call Clean
    Call Sub_Query(1)
    Exit Sub
ERR1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = Err.Description
    'Tsxx = "转帐过程中出现未知错误，程序自动恢复保存前状态！"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
End Sub
Private Sub Save_TempPz_Ass_Pre(VouchTemp_Id As Long, AccList_Id As Long, VouchModel As String, serial As Long, TranNoteCode As String)
    'VouchTemp_Id 表示临时凭证的ID号，AccList_Id 表示选择的需要生成凭证的明细帐记录的ID，VouchModel 为形成凭证的模板编号，serialnum 表示临时凭证子表中的记录顺序号
    Dim RecNote As New ADODB.Recordset            '应收票据记录集
    Dim RecNoteChange As New ADODB.Recordset      '票据变动记录集
    
    Dim Digest As String                    '摘要
    Dim AccCode As String                   '业务科目编码
    Dim AccCodeNote As String               '应收票据科目编码
    Dim AccCodeInterest As String           '利息科目编码
    Dim AccCodeExpense As String            '费用科目编码
    
    Dim DeptCode As String                  '部门编码
    Dim PersonCode As String                '经办人编码
    Dim CusCode As String                   '客户编码
    Dim SupplierCode As String              '供应商编码
    Dim ItemCode As String                  '项目编码
    
    Dim YbPmInterest As Double              '原币票面利息
    Dim BbPmInterest As Double              '本币票面利息
    Dim YbPmJe As Double                    '原币票面金额
    Dim BbPmJe As Double                    '本币票面金额
    
    Dim YbExpense As Double                 '原币变动费用
    Dim BbExpense As Double                 '本币变动费用
    Dim YbCash As Double                    '原币变动金额
    Dim BbCash As Double                    '本币变动金额
    
    Sqlstr = "SELECT * FROM Ar_v_NoteClose WHERE NoteCloseId='" & AccList_Id & "'"
    Set RecNoteChange = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    Sqlstr = "SELECT * FROM RP_Note WHERE NoteCode='" & TranNoteCode & "'"
    Set RecNote = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    '应收票据票面数据
    With RecNote
        YbPmInterest = Val(Trim(.Fields("YbInTerest") & ""))           '原币票面利息
        BbPmInterest = Val(Trim(.Fields("BbInTerest") & ""))           '本币票面利息
        YbPmJe = Val(Trim(.Fields("YbSsJe") & ""))                   '原币票面金额
        BbPmJe = Val(Trim(.Fields("BbSsJe") & ""))                   '本币票面金额
    End With
    
    '取变动单数据
    With RecNoteChange
        Digest = Trim(.Fields("Digest") & "") & Trim(.Fields("NoteCode") & "") '摘要
        AccCode = Trim(.Fields("AccCode") & "")                                '业务科目
        AccCodeNote = Trim(.Fields("AccCodeNote") & "")                        '应收票据科目
        AccCodeInterest = Trim(.Fields("AccCodeInterest") & "")      '利息科目编码
        AccCodeExpense = Trim(.Fields("AccCodeExpense") & "")        '费用科目编码
        DeptCode = Trim(.Fields("DeptCode") & "")                    '部门
        PersonCode = Trim(.Fields("PersonCode") & "")                '经办人编码
        CusCode = Trim(.Fields("PsCode") & "")                       '客户
        SupplierCode = Trim(.Fields("EndorseCusCode") & "")          '供应商
        ItemCode = ""                                                       '项目
        AccRate = Val(Trim(.Fields("AccRate") & ""))                 '记帐汇率
        BankBillNo = Trim(.Fields("BankBillNo") & "")                '银行票号
        SsCode = Trim(.Fields("SsCode") & "")                        '结算方式编码
        ForeignCurrCode = Trim(.Fields("ForeignCurrCode") & "")      '外币编码
        BillDate = CDate(Trim(.Fields("CloseDate") & ""))            '单据日期
        PersonName = Trim(.Fields("PersonName") & "")                '经办人姓名
        YbCash = Val(Trim(.Fields("YbCash") & ""))                   '原币变动金额
        BbCash = Val(Trim(.Fields("BbCash") & ""))                   '本币变动金额
        YbExpense = Val(Trim(.Fields("YbExpense") & ""))             '原币变动费用
        BbExpense = Val(Trim(.Fields("YbExpense") & ""))             '本币变动费用
        Select Case Trim(.Fields("BillItemCode") & "")
            Case "43"       '背书
                CustName = Trim(.Fields("CusName") & "")             '客户名称
                SuppName = Trim(.Fields("SupplierName") & "")        '供应商名称
            Case "41"       '转出
                CustName = Trim(.Fields("CusName") & "")             '客户名称
                SuppName = ""
            Case Else
                CustName = Trim(.Fields("CusName") & "")             '客户名称
                SuppName = ""
        End Select
    End With
    Select Case VouchModel
        Case "3"                      '借银行存款，借财务费用，贷应收票据（贴现、背书）
            '1写借银行存款或应付帐款
            YbJe = YbCash  '贴现、背书金额
            BbJe = BbCash
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCode, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "借")
             
             '2借财务费用
            YbJe = YbPmJe + YbPmInterest - YbCash '财务费用＝票面金额+票面利息－贴现金额
            BbJe = BbPmJe + BbPmInterest - BbCash
            If YbJe <> 0 Or BbJe <> 0 Then
               VouchRow = VouchRow + 1
               Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeExpense, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "借")
            End If
            '3贷应收票据
            YbJe = YbPmJe + YbPmInterest         '票面金额+票面利息
            BbJe = BbPmJe + BbPmInterest
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeNote, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "贷")
        Case "4"                      '借银行存款，贷应收票据（兑现,转出）      '
            '写借银行存款、应收、应付
            YbJe = YbCash            '兑现金额
            BbJe = BbCash
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCode, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "借")
             
             '贷应收票据
            YbJe = YbPmJe + YbPmInterest
            BbJe = BbPmJe + BbPmInterest
            VouchRow = VouchRow + 1
            Call Save_TempPz_Ass(VouchTemp_Id, VouchRow, Digest, AccCodeNote, DeptCode, PersonCode, CusCode, SupplierCode, ItemCode, "贷")
    End Select
End Sub
Private Sub Save_TempPz_Main(TranVouchClass1 As String, TranNo As Long, OperationNum1 As Long, VouchIdTemp_Id As Long)     '将有效数据写入临时凭证主表
    Dim Rec_VouchMainTemp As New ADODB.Recordset            '临时凭证主表记录集
    '打开临时凭证主表，存放有效凭证的凭证号等主信息
    If Rec_VouchMainTemp.State = 1 Then Rec_VouchMainTemp.Close
    Rec_VouchMainTemp.Open "select * from Cwzz_AccVouchMainTemp Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rec_VouchMainTemp
        .AddNew
        .Fields("VouchSource") = "应收系统"                  '凭证来源
        .Fields("OperationNo") = OperationNum1               '存放批号
        .Fields("VouchId") = VouchIdTemp_Id                  '临时凭证ID
        .Fields("Year") = Int_Kjyear                         '取选中的年份
        .Fields("period") = Int_Period                       '取选中的会计期间
        .Fields("Ddate") = Xtrq                              '取系统日期
        .Fields("VouchClassCode") = TranVouchClass1          '凭证类别
        .Fields("Doc") = 0
        .Fields("Bill") = Xtczy
        .Fields("OperationClass") = ""                       '业务类型
        .Fields("BillType") = ""
        .Fields("BillNo") = Str(TranNo)                      '存放行号
        .Fields("DeleteFlag") = IIf(Bln_DeleteFlag, 1, 0)
        
        .Update
    End With
End Sub
Private Sub Save_TempPz_Ass(VouchIdTemp_Id As Long, serialnum As Long, Str_Digest As String, Str_Kmh As String, str_Dept As String, Str_Per As String, Str_Cus As String, Str_Sup As String, Str_Item As String, str_TranOri As String) '写临时凭证辅表
    'VouchIdTemp_Id临时凭证主表、辅表对应关系Id号
    Dim Rec_VouchTemp As New ADODB.Recordset            '临时凭证辅表记录集
    Dim RecTemp As New ADODB.Recordset
    
    '打开临时凭证辅表,用于存放转帐凭证内容
    Rec_VouchTemp.Open "select * from Cwzz_AccVouchsubTemp where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * from Cwzz_AccCode where Ccode='" & Str_Kmh & "'")
    With Rec_VouchTemp
        .AddNew
        
        '[公共信息
        If str_TranOri = "贷" Then                               '
            .Fields("WbDfje") = YbJe                             '贷方金额
            .Fields("Dfje") = BbJe
        Else
            .Fields("WbJfje") = YbJe                             '借方金额
            .Fields("Jfje") = BbJe
        End If
        .Fields("Digest") = Str_Digest                            '摘要
        If RecTemp.EOF Then
            .Fields("Ccode") = Null
        Else
            .Fields("Ccode") = Str_Kmh                            '转帐科目号
        End If
        .Fields("VouchId") = VouchIdTemp_Id                      '与主表的对应ID
        .Fields("serialID") = serialnum                          '序号ID
        
        
        '[辅助信息
        If RecTemp.EOF = False Then
            If RecTemp.Fields("PersonFlag") = True Then
                .Fields("PersonCode") = Str_Per                  '个人
            End If
            If RecTemp.Fields("DeptFlag") = True Then
                .Fields("DeptCode") = str_Dept                   '部门
            End If
            If RecTemp.Fields("CusFlag") = True Then
                .Fields("CusCode") = Str_Cus                     '客户
            End If
            If RecTemp.Fields("SupplierFlag") = True Then
                .Fields("Suppliercode") = Str_Sup                '供应商
            End If
        End If
        '[币别信息
        .Fields("ForeignCurrCode") = ForeignCurrCode
        .Fields("AccRate") = AccRate
        If RecTemp.EOF = False Then
            '[银行结算信息
            If Trim(RecTemp.Fields("Cproperty")) = "银行" Then
                .Fields("SScode") = SsCode
                .Fields("BillNo") = BankBillNo
                .Fields("Digest") = Str_Digest & CustName & SuppName   '摘要
            End If
        End If
        .Fields("BillDate") = BillDate
        ']银行结算信息
        
        .Fields("TranPerson") = PersonName
        .Update
    End With
End Sub
Private Sub Sub_AllSelect() '全部选中
    Dim jsq As Long
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    For jsq = CxbbGrid.FixedRows To Jsq_Max
       CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "√"
       If CxbbGrid.TextMatrix(jsq, 1) = True Then
          CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = ""  '单据已制作凭证
       End If
       If Val(CxbbGrid.TextMatrix(jsq, 2)) <> 0 And Trim(CxbbGrid.TextMatrix(jsq, Sydz("010", GridStr(), Szzls))) = "" Then
          CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "" '该变动单对应的其它应收单没有审核
       End If
       If Val(CxbbGrid.TextMatrix(jsq, 3)) <> 0 And Trim(CxbbGrid.TextMatrix(jsq, Sydz("010", GridStr(), Szzls))) = "" Then
          CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "" '列表中有对应的其它应付单没有审核
       End If
    Next jsq
End Sub
Private Sub Sub_AllCancel() '全部取消
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    For jsq = CxbbGrid.FixedRows To Jsq_Max
       CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = ""
    Next jsq
End Sub
Private Sub Sub_Unit() '合并
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    For jsq = CxbbGrid.FixedRows To Jsq_Max
       If CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "√" Then
            CxbbGrid.TextMatrix(jsq, Sydz("001", GridStr(), Szzls)) = "1"
       End If
    Next jsq
End Sub
Private Sub Start()  '初始化表单界面,填充凭证类型
    Dim RecTemp As New ADODB.Recordset
    Dim i As Integer
    
    MenuBillCode_Con = " BillItemCode Like '" & MenuBillCode & "%' and RPFlag='" & ArApFlag & "' "
    
    '填充表单上的日期和凭证类别
    LabDate.Caption = Xtrq                                        '生成凭证日期
    
    Call FillImageCombo(Imagbo_Vouch, "cwzz_AccVouchClass", 1)    '填充凭证类别列表
    
    Sqlstr = "SELECT * FROM RP_TranVouch WHERE " & MenuBillCode_Con
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If RecTemp.EOF = False Then
        For i = 1 To Imagbo_Vouch.ComboItems.Count
            If Trim(Mid(Imagbo_Vouch.ComboItems(i).Key, 2, Len(Imagbo_Vouch.ComboItems(i).Key))) = Trim(RecTemp.Fields("VouchClassCode")) Then
                Imagbo_Vouch.ComboItems.Item(i).Selected = True
            End If
        Next i
    End If
    Rec = "RP_OtherBill"        '其它应收、应付单数据表
    RecBillId = "OtherBillId"   '其它应收、应付单的单据ID
End Sub
Private Sub WriteVouchId()                      '回写正式凭证ID到单据表和明细帐表中
    Dim Rec_VouchMain As New ADODB.Recordset    '临时主凭证记录集
    Dim EffectListId As Long                    '已经保存为正式凭证的变动表记录ID（即有效的记录）
    Dim EffectVouchId As Long                   '生成正式凭证的凭证ID
    Dim BillIdAr As Long                        '应收单ID
    Dim BillIdAp As Long                        '应付单ID
    
    Sqlstr = "SELECT * FROM Cwzz_AccVouchMainTemp WHERE SureVouchId>0 and OperationNo='" & OperationNum & "' order by BillNo"
    Set Rec_VouchMain = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Rec_VouchMain.EOF = False Then
        Select Case UnitFlag
            Case True           '如果凭证合并生成，则按网格中记录的NoteCloseId(jsq)来回写数据，因为这种情况下，临时凭证主表中存放的是批号。
                For jsq = 1 To TranJsq
                
                    '将生成的凭证ID记录到变动表中
                    EffectListId = FiltListId(jsq)                          '已经生成凭证的变动单Id
                    EffectVouchId = Rec_VouchMain.Fields("SureVouchId")     '已生成的正式凭证的ID
                    BillIdAr = Val(CxbbGrid.TextMatrix(jsq, 2))             '应收单ID
                    BillIdAp = Val(CxbbGrid.TextMatrix(jsq, 3))             '应付单ID
                    Cw_DataEnvi.DataConnect.Execute ("Update RP_NoteClose set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where NoteCloseID='" & EffectListId & "'")
        
                    '转出处理时，需要将生成的凭证记录到其它应收单和明细帐中
                    If BillIdAr <> 0 Then             '应收单记录ID
                       
                       '写其它应收单中
                       Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where " & RecBillId & "='" & BillIdAr & "'")
                       
                       '写明细帐中
                       Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where BillId='" & BillIdAr & "' and BillItemCode like '2%'")
                    End If
                    
                    '当背书处理时，需要将生成的凭证记录到其它应付单和明细帐中
                    If BillIdAp <> 0 Then            '应付单记录ID
                             
                       '写其它应付单中
                        Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where " & RecBillId & "='" & BillIdAp & "'")
                       '将明细帐中
                       Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where BillId='" & BillIdAp & "' and BillItemCode like '8%'")
                    End If
                Next jsq
            Case False          '如果凭证按单张生成，则按临时凭证主表中记录的AccListId(jsq)回写数据。
                Do While Rec_VouchMain.EOF = False
        
                    '将生成的凭证记录到变动表中
                    EffectListId = Rec_VouchMain.Fields("BillNo")         '已经生成凭证的变动单Id
                    EffectVouchId = Rec_VouchMain.Fields("SureVouchId")   '已生成的正式凭证的ID
                    Cw_DataEnvi.DataConnect.Execute ("Update RP_NoteClose set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where NoteCloseID='" & EffectListId & "'")
                  
                    '将生成的凭证号记录到对应单据中（背书和转出时用）
                    Sqlstr = "SELECT BillIdAr,BillIdAp FROM RP_NoteClose WHERE NoteCloseId='" & EffectListId & "'"
                    Set Rec_NoteClose = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If Val(Trim(Rec_NoteClose.Fields("BillIdAr") & "")) <> 0 Then
                        BillIdAr = Rec_AccList.Fields("BillIdAr")        '变动单中记录的已生成凭证的单据ID
                        Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where " & RecBillId & "='" & BillIdAr & "'")
                        Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where BillId='" & BillIdAr & "' and BillItemCode like '2%'")
                    End If
                    If Val(Trim(Rec_NoteClose.Fields("BillIdAp") & "")) <> 0 Then
                        BillIdAp = Rec_AccList.Fields("BillIdAp")        '变动单中记录的已生成凭证的单据ID
                        Cw_DataEnvi.DataConnect.Execute ("Update " & Rec & " set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where " & RecBillId & "='" & BillIdAp & "'")
                        Cw_DataEnvi.DataConnect.Execute ("Update RP_AccList set VouchId='" & EffectVouchId & "',IfBuildVouch='1' where BillId='" & BillIdAp & "' and BillItemCode like '8%'")
                    End If
                    
                    Rec_VouchMain.MoveNext
                Loop
        End Select
    End If
End Sub
Private Sub Clean()               '删除临时数据表数据
    If Bln_DeleteFlag = True Then
        '删除临时凭证主从表
        Cw_DataEnvi.DataConnect.Execute "Delete From Cwzz_AccVouchSubTemp Where VouchId in (select VouchId from Cwzz_AccVouchMainTemp where OperationNo='" & OperationNum & "')"
        Cw_DataEnvi.DataConnect.Execute "Delete From Cwzz_AccVouchMainTemp Where OperationNo='" & OperationNum & "'"
    End If
End Sub

						