i-
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:9k
源码类别:

企业管理

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
  3. Begin VB.Form ZbqlFrm 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "帐簿清理"
  6.    ClientHeight    =   4170
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   4560
  10.    HelpContextID   =   501008
  11.    Icon            =   "帐簿清理.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    LockControls    =   -1  'True
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   4170
  17.    ScaleWidth      =   4560
  18.    ShowInTaskbar   =   0   'False
  19.    StartUpPosition =   2  '屏幕中心
  20.    Begin VB.CommandButton QxCommand 
  21.       Cancel          =   -1  'True
  22.       Caption         =   "取消(&C)"
  23.       Height          =   300
  24.       Left            =   3365
  25.       TabIndex        =   0
  26.       Top             =   3810
  27.       Width           =   1120
  28.    End
  29.    Begin VB.CommandButton QdCommand 
  30.       Caption         =   "清理(&L)"
  31.       Height          =   300
  32.       Left            =   2165
  33.       TabIndex        =   2
  34.       Top             =   3810
  35.       Width           =   1120
  36.    End
  37.    Begin VSFlex8Ctl.VSFlexGrid CzxsGrid 
  38.       Height          =   3675
  39.       Left            =   60
  40.       TabIndex        =   1
  41.       Top             =   60
  42.       Width           =   4425
  43.       _ExtentX        =   7805
  44.       _ExtentY        =   6482
  45.       Appearance      =   1
  46.       BorderStyle     =   1
  47.       Enabled         =   -1  'True
  48.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  49.          Name            =   "宋体"
  50.          Size            =   9
  51.          Charset         =   134
  52.          Weight          =   400
  53.          Underline       =   0   'False
  54.          Italic          =   0   'False
  55.          Strikethrough   =   0   'False
  56.       EndProperty
  57.       MousePointer    =   0
  58.       BackColor       =   -2147483643
  59.       ForeColor       =   -2147483640
  60.       BackColorFixed  =   -2147483633
  61.       ForeColorFixed  =   -2147483630
  62.       BackColorSel    =   -2147483635
  63.       ForeColorSel    =   -2147483634
  64.       BackColorBkg    =   8421504
  65.       BackColorAlternate=   -2147483643
  66.       GridColor       =   -2147483633
  67.       GridColorFixed  =   -2147483632
  68.       TreeColor       =   -2147483632
  69.       FloodColor      =   192
  70.       SheetBorder     =   -2147483642
  71.       FocusRect       =   1
  72.       HighLight       =   1
  73.       AllowSelection  =   -1  'True
  74.       AllowBigSelection=   -1  'True
  75.       AllowUserResizing=   0
  76.       SelectionMode   =   0
  77.       GridLines       =   1
  78.       GridLinesFixed  =   2
  79.       GridLineWidth   =   1
  80.       Rows            =   5000
  81.       Cols            =   10
  82.       FixedRows       =   1
  83.       FixedCols       =   0
  84.       RowHeightMin    =   0
  85.       RowHeightMax    =   0
  86.       ColWidthMin     =   0
  87.       ColWidthMax     =   0
  88.       ExtendLastCol   =   0   'False
  89.       FormatString    =   ""
  90.       ScrollTrack     =   0   'False
  91.       ScrollBars      =   3
  92.       ScrollTips      =   0   'False
  93.       MergeCells      =   0
  94.       MergeCompare    =   0
  95.       AutoResize      =   -1  'True
  96.       AutoSizeMode    =   0
  97.       AutoSearch      =   0
  98.       MultiTotals     =   -1  'True
  99.       SubtotalPosition=   1
  100.       OutlineBar      =   0
  101.       OutlineCol      =   0
  102.       Ellipsis        =   0
  103.       ExplorerBar     =   0
  104.       PicturesOver    =   0   'False
  105.       FillStyle       =   0
  106.       RightToLeft     =   0   'False
  107.       PictureType     =   0
  108.       TabBehavior     =   0
  109.       OwnerDraw       =   0
  110.       Editable        =   0   'False
  111.       ShowComboButton =   -1  'True
  112.       WordWrap        =   0   'False
  113.       TextStyle       =   0
  114.       TextStyleFixed  =   0
  115.       OleDragMode     =   0
  116.       OleDropMode     =   0
  117.       DataMode        =   0
  118.       VirtualData     =   -1  'True
  119.    End
  120. End
  121. Attribute VB_Name = "ZbqlFrm"
  122. Attribute VB_GlobalNameSpace = False
  123. Attribute VB_Creatable = False
  124. Attribute VB_PredeclaredId = True
  125. Attribute VB_Exposed = False
  126. '**********************************************
  127. '*    模 块 名 称 :帐簿清理
  128. '*    功 能 描 述 :清除用户所选中数据表中的记录
  129. '*    程序员姓名  : 徐衍民
  130. '*    最后修改人  : 徐衍民
  131. '*    最后修改时间:2001/11/16
  132. '*    备        注:
  133. '**********************************************
  134. '自定义变量
  135. Dim rstemp As ADODB.Recordset            '数据表动态集
  136. Dim Jsqte As Long                        '查询临时使用变量
  137. Dim rs As ADODB.Recordset                '临时打开数据集变量
  138. '以下为固定使用变量(网格)
  139. Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
  140. Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
  141. Dim GridCode As String                   '显示网格网格代码
  142. Dim GridInf() As Variant                 '整个网格设置信息
  143. Dim Tsxx As String                       '系统提示信息
  144. Dim Qslz As Long                         '网格隐藏(非操作显示)列数
  145. Dim Sjhgd As Double                      '网格数据行高度
  146. Dim GridBoolean() As Boolean             '网格列信息(布尔型)
  147. Dim GridStr()  As String                 '网格列信息(字符型)
  148. Dim GridInt() As Integer                 '网格列信息(整型)
  149. Dim Szzls As Integer                     '数组总列数(网格列数-1)
  150. Private Sub Form_Load()                  '窗体装入
  151.   
  152.     '调入网格设置信息
  153.     GridCode = "Gdzc_LedgerManage"
  154.     Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  155.     Qslz = GridInf(1)
  156.     Sjhgd = GridInf(2)
  157.     Szzls = CzxsGrid.Cols - 1
  158.     
  159.     '填 充 网 格
  160.     Call Cxnrtcwg
  161.   
  162. End Sub
  163. Private Sub Cxnrtcwg()                  '查询内容填充网格
  164.     Dim Sqlstr As String              '查询连接串
  165.     
  166.     Sqlstr = "SELECT * FROM Gdzc_Ledgermanage Order By asin(whetherDelete)" '打开帐簿管理数据集
  167.     Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  168.     
  169.     With Cxnrrec
  170.         CzxsGrid.Rows = CzxsGrid.FixedRows
  171.         If .EOF And .BOF Then
  172.             CzxsGrid.Redraw = True
  173.             Exit Sub
  174.         End If
  175.         Jsqte = CzxsGrid.FixedRows
  176.         Do While Not .EOF
  177.             CzxsGrid.AddItem ""
  178.             Call Jltcwg(Cxnrrec, Jsqte)                              '调入填充网格子过程
  179.             CzxsGrid.RowHeight(Jsqte) = Sjhgd                        '设置网格高度
  180.             .MoveNext
  181.             Jsqte = Jsqte + 1
  182.         Loop
  183.     End With
  184.   
  185. End Sub
  186. Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格
  187.     With Jlbrec
  188.         CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("TableName") & "")        '数据表名称
  189.         CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("TableDpiction") & "")    '数据表描述
  190.         If .Fields("whetherDelete") = True Then
  191.             CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = "√"                               '是否可以删除
  192.         End If
  193.     End With
  194.     
  195. End Sub
  196. Private Sub QdCommand_Click()   '确定,清空用户所选中的数据表
  197.     
  198.     If MsgBox("是否确定要删除所选中的数据表?", vbOKCancel + vbDefaultButton2 + vbQuestion, "百利/ERP5.0-固定资产") = vbOK Then
  199.         
  200.         Cw_DataEnvi.DataConnect.BeginTrans      '事务处理
  201.         On Error GoTo Cwcl
  202.         With CzxsGrid
  203.             For Jsqte = CzxsGrid.FixedRows To CzxsGrid.Rows - 1
  204.                 If CzxsGrid.TextMatrix(Jsqte, 3) = "√" Then
  205.                     Cw_DataEnvi.DataConnect.Execute ("delete " & Trim(CzxsGrid.TextMatrix(Jsqte, 1)))  '执行删除操作
  206.                 End If
  207.             Next Jsqte
  208.         End With
  209.         
  210.         '将会计日历表中固定资产结帐标志赋成未结帐状态。
  211.         Cw_DataEnvi.DataConnect.Execute ("update gy_kjrlb set gdzcjzbz='0' where gdzcjzbz='1'")
  212.         
  213.         '卡片清除后,将自定义文本框值赋成原始
  214.         For Jsqte = 1 To 20
  215.             Set rstemp = New ADODB.Recordset
  216.             rstemp.Open "SELECT * From Xt_text_input WHERE system_code = 'gdzc' AND text_group_code = 'gdzc_cardjbcz' and text_name='自定义" & Jsqte & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  217.             If Not rstemp.EOF Then
  218.                 Set rs = New ADODB.Recordset
  219.                 rs.Open "select * from Gdzc_custom where fieldCode='zdy" & Jsqte & "' and FieldState='1'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  220.                 If rs.EOF Then
  221.                     rstemp.Fields("Text_data_type") = 0
  222.                     rstemp.Fields("Text_Length") = 0
  223.                     rstemp.Fields("judge_type") = 0
  224.                     rstemp.Update
  225.                 End If
  226.                 rs.Close
  227.                 Set rs = Nothing
  228.             End If
  229.             rstemp.Close
  230.             Set rstemp = Nothing
  231.         Next Jsqte
  232.         
  233.         '将自定义属性表中是否有数据字段内容赋成空
  234.         Cw_DataEnvi.DataConnect.Execute ("update gdzc_custom set whetherNull='0'")
  235.         
  236.         Cw_DataEnvi.DataConnect.CommitTrans     '使用事务处理,执行物理删除
  237.         Tsxx = "帐簿清理完毕!"
  238.         Call Xtxxts(Tsxx, 0, 4)
  239.         Unload Me
  240.         Exit Sub
  241. Cwcl:
  242.         Cw_DataEnvi.DataConnect.RollbackTrans   '使用事务处理,恢复删除记录
  243.         Tsxx = "帐簿清理过程中出现未知错误,程序自动恢复折旧前状态!"
  244.         Call Xtxxts(Tsxx, 0, 1)
  245.         Exit Sub
  246.     End If
  247. End Sub
  248. Private Sub QxCommand_Click()                              '取 消
  249.     Unload Me               '退出当前窗体
  250. End Sub