企业管理

开发平台：
Visual Basic

+：源码内容
							VERSION 5.00
Begin VB.Form Jcsz_Ywfw 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "业务范围"
   ClientHeight    =   4740
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4485
   HelpContextID   =   130101
   Icon            =   "基础设置_业务范围.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4740
   ScaleWidth      =   4485
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Com_Save 
      Caption         =   "保存(&S)"
      Height          =   300
      Left            =   1965
      TabIndex        =   14
      Top             =   4335
      Width           =   1120
   End
   Begin VB.CommandButton Com_Cancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   3195
      TabIndex        =   20
      Top             =   4335
      Width           =   1120
   End
   Begin VB.Frame Frame1 
      Height          =   4170
      Left            =   120
      TabIndex        =   15
      Top             =   30
      Width           =   4215
      Begin VB.CheckBox Che_Xtjc 
         Caption         =   "系统集成"
         Height          =   315
         Left            =   300
         TabIndex        =   8
         Top             =   2250
         Value           =   1  'Checked
         Width           =   1515
      End
      Begin VB.Frame Frame6 
         Caption         =   "零成本出库方式"
         Height          =   1935
         Left            =   150
         TabIndex        =   18
         Top             =   240
         Width           =   2055
         Begin VB.OptionButton Opt_Ckfs 
            Caption         =   "手工输入"
            Height          =   255
            Index           =   4
            Left            =   180
            TabIndex        =   4
            Top             =   1560
            Value           =   -1  'True
            Width           =   1065
         End
         Begin VB.OptionButton Opt_Ckfs 
            Caption         =   "结存成本"
            Height          =   255
            Index           =   3
            Left            =   180
            TabIndex        =   3
            Top             =   1260
            Width           =   1065
         End
         Begin VB.OptionButton Opt_Ckfs 
            Caption         =   "参考成本"
            Height          =   255
            Index           =   2
            Left            =   180
            TabIndex        =   2
            Top             =   930
            Width           =   1065
         End
         Begin VB.OptionButton Opt_Ckfs 
            Caption         =   "上次出库成本"
            Height          =   255
            Index           =   1
            Left            =   180
            TabIndex        =   1
            Top             =   600
            Width           =   1425
         End
         Begin VB.OptionButton Opt_Ckfs 
            Caption         =   "上次入库成本"
            Height          =   255
            Index           =   0
            Left            =   180
            TabIndex        =   0
            Top             =   270
            Width           =   1425
         End
      End
      Begin VB.Frame Frame5 
         Caption         =   "暂估方式"
         Height          =   1245
         Left            =   2340
         TabIndex        =   17
         Top             =   240
         Width           =   1725
         Begin VB.OptionButton Opt_Zgcl 
            Caption         =   "单到补差"
            Enabled         =   0   'False
            Height          =   225
            Index           =   2
            Left            =   210
            TabIndex        =   7
            Top             =   870
            Width           =   1095
         End
         Begin VB.OptionButton Opt_Zgcl 
            Caption         =   "单到回冲"
            Enabled         =   0   'False
            Height          =   225
            Index           =   1
            Left            =   225
            TabIndex        =   6
            Top             =   570
            Width           =   1095
         End
         Begin VB.OptionButton Opt_Zgcl 
            Caption         =   "月初回冲"
            Enabled         =   0   'False
            Height          =   225
            Index           =   0
            Left            =   210
            TabIndex        =   5
            Top             =   270
            Value           =   -1  'True
            Width           =   1095
         End
      End
      Begin VB.CheckBox Che_Check 
         Caption         =   "期末处理差异"
         Height          =   315
         Index           =   0
         Left            =   300
         TabIndex        =   10
         Top             =   2865
         Value           =   1  'Checked
         Width           =   1785
      End
      Begin VB.CheckBox Che_Check 
         Caption         =   "差异率计算包括本期暂估"
         Height          =   315
         Index           =   1
         Left            =   300
         TabIndex        =   11
         Top             =   3165
         Value           =   1  'Checked
         Width           =   2325
      End
      Begin VB.CheckBox Che_Check 
         Caption         =   "材料入库单是库房系统生成"
         Height          =   315
         Index           =   3
         Left            =   300
         TabIndex        =   13
         Top             =   3765
         Value           =   1  'Checked
         Width           =   2505
      End
      Begin VB.CheckBox Che_Check 
         Caption         =   "系统处理暂估"
         Height          =   315
         Index           =   4
         Left            =   300
         TabIndex        =   9
         Top             =   2550
         Value           =   1  'Checked
         Width           =   1515
      End
      Begin VB.TextBox Txt_Qcyf 
         Alignment       =   2  'Center
         Height          =   300
         Left            =   3330
         MaxLength       =   2
         TabIndex        =   16
         Text            =   "1"
         Top             =   1725
         Width           =   360
      End
      Begin VB.CheckBox Che_Check 
         Caption         =   "系统处理出库金额自填"
         Height          =   315
         Index           =   2
         Left            =   300
         TabIndex        =   12
         Top             =   3480
         Value           =   1  'Checked
         Width           =   2145
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "开帐月份："
         Height          =   195
         Left            =   2400
         TabIndex        =   19
         Top             =   1785
         Width           =   900
      End
   End
End
Attribute VB_Name = "Jcsz_Ywfw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Tsxx As String               '系统提示信息
Private Sub Com_Save_Click()
  
    '保存用户设置
    Call Sub_SaveDefine
    
    '重新读入系统帐套参数
    Call Drxtztcs
    
    Unload Me
   
End Sub
Private Sub Che_Check_Click(Index As Integer)
    If Che_Check(0).Value = 1 And Che_Check(4).Value = 1 Then
        If Not Index = 1 Then
            Che_Check(1).Value = 1
        Else
            Che_Check(1).Value = 0
        End If
    Else
        Che_Check(1).Value = 0
    End If
  
End Sub
Private Sub Sub_SaveDefine()                   '保存用户设置
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '保存网格设置
    With RecTemp
        If .State = 1 Then .Close
        
            .Open "Select * From Gy_AccInformation Where SystemCode='chhs'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
          
            .MoveFirst
            .Find "itemcode='Chhs_Qmclcy'"
            If Not .EOF Then
                .Fields("itemvalue") = Che_Check(0).Value
                .Update
            End If
            .MoveFirst
            .Find "itemcode='Chhs_Xtclzg'"
            If Not .EOF Then
                .Fields("itemvalue") = Che_Check(4).Value
                .Update
            End If
            .MoveFirst
            .Find "itemcode='Chhs_Cylzg'"
            If Not .EOF Then
                .Fields("itemvalue") = Che_Check(1).Value
                .Update
            End If
            .MoveFirst
            .Find "itemcode='Chhs_ClrkdKfsc'"
            If Not .EOF Then
                .Fields("itemvalue") = Che_Check(3).Value
                .Update
            End If
            .MoveFirst
            .Find "itemcode='Chhs_Xtjc'"
            If Not .EOF Then
                .Fields("itemvalue") = Che_Xtjc.Value
                .Update
            End If
            .MoveFirst
            .Find "itemcode='Chhs_SFjezt'"
            If Not .EOF Then
                .Fields("itemvalue") = Che_Check(2).Value
                .Update
            End If
            .MoveFirst
            .Find "itemcode='Chhs_Eval1'"
            If Not .EOF Then
                If Opt_Zgcl(0).Value Then
                    .Fields("itemvalue") = 1
                Else
                    .Fields("itemvalue") = 0
                End If
                .Update
            End If
            .MoveFirst
            .Find "itemcode='Chhs_Eval2'"
            If Not .EOF Then
                If Opt_Zgcl(1).Value Then
                    .Fields("itemvalue") = 1
                Else
                    .Fields("itemvalue") = 0
                End If
                .Update
            End If
            .MoveFirst
            .Find "itemcode='Chhs_Eval3'"
            If Not .EOF Then
                If Opt_Zgcl(2).Value Then
                    .Fields("itemvalue") = 1
                Else
                    .Fields("itemvalue") = 0
                End If
                .Update
            End If
             .MoveFirst
            .Find "itemcode='Chhs_Lcbck1'"
            If Not .EOF Then
                If Opt_Ckfs(0).Value Then
                    .Fields("itemvalue") = 1
                Else
                    .Fields("itemvalue") = 0
                End If
                .Update
            End If
             .MoveFirst
            .Find "itemcode='Chhs_Lcbck2'"
            If Not .EOF Then
                If Opt_Ckfs(1).Value Then
                    .Fields("itemvalue") = 1
                Else
                    .Fields("itemvalue") = 0
                End If
                .Update
            End If
             .MoveFirst
            .Find "itemcode='Chhs_Lcbck3'"
            If Not .EOF Then
                If Opt_Ckfs(2).Value Then
                    .Fields("itemvalue") = 1
                Else
                    .Fields("itemvalue") = 0
                End If
                .Update
            End If
             .MoveFirst
            .Find "itemcode='Chhs_Lcbck4'"
            If Not .EOF Then
                If Opt_Ckfs(3).Value Then
                    .Fields("itemvalue") = 1
                Else
                    .Fields("itemvalue") = 0
                End If
                .Update
            End If
             .MoveFirst
            .Find "itemcode='Chhs_Lcbck5'"
            If Not .EOF Then
                If Opt_Ckfs(4).Value Then
                    .Fields("itemvalue") = 1
                Else
                    .Fields("itemvalue") = 0
                End If
                .Update
            End If
   End With
    
    Cw_DataEnvi.DataConnect.CommitTrans
    Set RecTemp = Nothing
    
    Tsxx = "保存完毕!"
    Call Xtxxts(Tsxx, 0, 4)
   
End Sub
Private Sub Che_Xtjc_Click()
    
    If Che_Xtjc.Value = 0 Then
       Che_Check(3).Value = 0
       Che_Check(3).Enabled = False
    Else
       Che_Check(3).Enabled = True
    End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移(Fixed)
    Dim jdzygs As Integer                         '控件焦点转移个数
    jdzygs = 30
    Select Case KeyAscii
        Case vbKeyReturn
            If Kjjdzy(jdzygs) Then
                KeyAscii = 0
            End If
        Case 39           '屏蔽"'"
            KeyAscii = 0
    End Select
End Sub
Private Sub Form_Load()
 
    '调 入 初 始 值
    Call Sub_Csdy
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_YwfwEdit", Xtczybm, 1, True, False) Then
        Com_Save.Enabled = False
    End If
End Sub
Private Sub Com_Cancel_Click()
    Unload Me
  
End Sub
Private Sub Sub_Csdy()        '初始参数
    Dim RecTemp As Recordset
    Dim Rectempfz As Recordset
  
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("select * from Gy_AccInformation where SystemCode ='Chhs'")
   
    With RecTemp
 
        If Not .EOF Then
        
            '期末是否处理差异
            .MoveFirst
            .Find "itemcode='Chhs_Qmclcy'"
            If Not .EOF Then
                Che_Check(0).Value = .Fields("itemvalue")
            End If
          
            '系统是否处理暂估
            .MoveFirst
            .Find "itemcode='Chhs_Xtclzg'"
            If Not .EOF Then
                Che_Check(4).Value = .Fields("itemvalue")
            End If
            
            '系统集成
            .MoveFirst
            .Find "itemcode='Chhs_Xtjc'"
            If Not .EOF Then
                Che_Xtjc.Value = .Fields("itemvalue")
            End If
            
            If Che_Xtjc.Value = 0 Then
                Che_Check(3).Enabled = False
            End If
          
            '差异率计算是否包括暂估
            .MoveFirst
            .Find "itemcode='Chhs_Cylzg'"
            If Not .EOF Then
                Che_Check(1).Value = .Fields("itemvalue")
            End If
          
            '材料入库单是否是库房系统生成
            .MoveFirst
            .Find "itemcode='Chhs_ClrkdKfsc'"
            If Not .EOF Then
                Che_Check(3).Value = .Fields("itemvalue")
            End If
          
            
            '上次入库成本
            .MoveFirst
            .Find "itemcode='Chhs_Lcbck1'"
            If Not .EOF Then
                Opt_Ckfs(0).Value = .Fields("itemvalue")
            End If
          
            '上次出库成本
            .MoveFirst
            .Find "itemcode='Chhs_Lcbck2'"
            If Not .EOF Then
                Opt_Ckfs(1).Value = .Fields("itemvalue")
            End If
          
            '上次出库成本
            .MoveFirst
            .Find "itemcode='Chhs_Lcbck2'"
            If Not .EOF Then
                Opt_Ckfs(1).Value = .Fields("itemvalue")
            End If
          
            '参考成本
            .MoveFirst
            .Find "itemcode='Chhs_Lcbck3'"
            If Not .EOF Then
                Opt_Ckfs(2).Value = .Fields("itemvalue")
            End If
          
            '结存成本
            .MoveFirst
            .Find "itemcode='Chhs_Lcbck4'"
            If Not .EOF Then
                Opt_Ckfs(3).Value = .Fields("itemvalue")
            End If
          
            '手工输入
            .MoveFirst
            .Find "itemcode='Chhs_Lcbck5'"
            If Not .EOF Then
                Opt_Ckfs(4).Value = .Fields("itemvalue")
            End If
          
          
            '月初回冲
            .MoveFirst
            .Find "itemcode='Chhs_Eval1'"
            If Not .EOF Then
                Opt_Zgcl(0).Value = .Fields("itemvalue")
            End If
          
            '单到回冲
            .MoveFirst
            .Find "itemcode='Chhs_Eval2'"
            If Not .EOF Then
                Opt_Zgcl(1).Value = .Fields("itemvalue")
            End If
          
            '单到补差
            .MoveFirst
            .Find "itemcode='Chhs_Eval3'"
            If Not .EOF Then
                Opt_Zgcl(2).Value = .Fields("itemvalue")
            End If
        End If
        
    End With
    
    '开帐月份
    Txt_Qcyf.Text = StartMon
     
    '正常单据录入后，业务范围不能修改
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("select * from chhs_startinputmain ")
    If Not RecTemp.EOF Then
       Com_Save.Enabled = False
    End If
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_inoutmain ")
    If Not RecTemp.EOF Then
       Com_Save.Enabled = False
    End If
    Set RecTemp = Nothing
   
End Sub

						