企业管理

开发平台：
Visual Basic

Form_NewKJQJ.frm：源码内容
							VERSION 5.00
Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form Form_NewKJQJ 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "创建下年度会计期间"
   ClientHeight    =   4290
   ClientLeft      =   1095
   ClientTop       =   2355
   ClientWidth     =   5430
   Icon            =   "Form_NewKJQJ.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4290
   ScaleWidth      =   5430
   Begin VB.CommandButton Command1 
      Caption         =   "确定&D"
      Height          =   315
      Index           =   0
      Left            =   2850
      TabIndex        =   1
      Top             =   3900
      Width           =   1125
   End
   Begin VB.CommandButton Command1 
      Caption         =   "取消&C"
      Height          =   315
      Index           =   1
      Left            =   4230
      TabIndex        =   0
      Top             =   3900
      Width           =   1125
   End
   Begin TabDlg.SSTab SSTab1 
      Height          =   3795
      Left            =   30
      TabIndex        =   2
      Top             =   30
      Width           =   5325
      _ExtentX        =   9393
      _ExtentY        =   6694
      _Version        =   393216
      Style           =   1
      Tabs            =   1
      TabHeight       =   520
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      TabCaption(0)   =   "会计期间"
      TabPicture(0)   =   "Form_NewKJQJ.frx":08CA
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "Label2"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).Control(1)=   "FlexGrid"
      Tab(0).Control(1).Enabled=   0   'False
      Tab(0).Control(2)=   "Text2"
      Tab(0).Control(2).Enabled=   0   'False
      Tab(0).ControlCount=   3
      Begin VB.TextBox Text2 
         Enabled         =   0   'False
         Height          =   315
         Left            =   2850
         Locked          =   -1  'True
         TabIndex        =   3
         Text            =   "2000"
         Top             =   1470
         Width           =   1185
      End
      Begin VSFlex8Ctl.VSFlexGrid FlexGrid 
         Height          =   3135
         Left            =   210
         TabIndex        =   4
         Top             =   450
         Width           =   2145
         _cx             =   8326856
         _cy             =   8328602
         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    =   1
         BackColor       =   -2147483643
         ForeColor       =   -2147483640
         BackColorFixed  =   -2147483633
         ForeColorFixed  =   -2147483630
         BackColorSel    =   -2147483635
         ForeColorSel    =   -2147483634
         BackColorBkg    =   -2147483636
         BackColorAlternate=   -2147483643
         GridColor       =   -2147483633
         GridColorFixed  =   -2147483632
         TreeColor       =   -2147483632
         FloodColor      =   192
         SheetBorder     =   -2147483642
         FocusRect       =   1
         HighLight       =   1
         AllowSelection  =   -1  'True
         AllowBigSelection=   -1  'True
         AllowUserResizing=   1
         SelectionMode   =   1
         GridLines       =   1
         GridLinesFixed  =   2
         GridLineWidth   =   1
         Rows            =   13
         Cols            =   2
         FixedRows       =   1
         FixedCols       =   0
         RowHeightMin    =   275
         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        =   1
         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
         Begin VB.TextBox Data_T 
            BorderStyle     =   0  'None
            Height          =   225
            Left            =   450
            TabIndex        =   5
            Top             =   270
            Visible         =   0   'False
            Width           =   1335
         End
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "下会计年度:"
         Height          =   180
         Left            =   2850
         TabIndex        =   6
         Top             =   1230
         Width           =   990
      End
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Index           =   0
      Left            =   3690
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   2970
      Visible         =   0   'False
      Width           =   615
   End
End
Attribute VB_Name = "Form_NewKJQJ"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Row_int As Integer, Col_int As Integer
Private Sub Command1_Click(Index As Integer)
    Dim Ssql As String
    Dim I As Integer, J As Integer
    Dim ado_Date As New Recordset, fld As ADODB.Field
    On Error GoTo ERROR_EXIT
    
    If Index = 1 Then Unload Me: Exit Sub
    
    YesNoStr = MsgBox("你是否真的要创建下年度会计期间！  ", vbYesNo + 32)
    If YesNoStr = vbNo Then Exit Sub
    
    ado_Date.Open "Select * from " & Trim(Text1(0).Tag) & ".dbo.Gy_kjrlb", Conn_System, adOpenStatic, adLockBatchOptimistic
    With ado_Date
        For I = 1 To 12
            .AddNew
            !KjYear = Trim(Text2.Text)
            !Period = FlexGrid.TextMatrix(I, 0)
            !qsrq = FlexGrid.TextMatrix(I, 1)
            If I < 12 Then
                !zzrq = DateAdd("d", -1, FlexGrid.TextMatrix(I + 1, 1))
             Else
                !zzrq = DateAdd("d", -1, DateAdd("m", 1, FlexGrid.TextMatrix(I, 1)))
            End If
            ' 将各种逻辑字段设定为0
            For Each fld In .Fields
                If fld.Type = adBoolean Then
                    fld.Value = False
                End If
            Next
            
            .Update
        Next
        .UpdateBatch adAffectAllChapters
        .Close
        Set ado_Date = Nothing
    End With
    
    Unload Me
    Exit Sub
    
ERROR_EXIT:
    MsgBox Err.Description, 16
End Sub
Private Sub Data_T_GotFocus()
    With FlexGrid
        If .Col = 1 Then
            Data_T.Text = .TextMatrix(.Row, 1)
            Data_T.SelLength = Len(Data_T.Text)
            Row_int = .Row
            Col_int = .Col
        End If
    End With
End Sub
Private Sub Data_T_LostFocus()
    Dim I As Integer
    Dim r As Integer
    Dim data_er As Date
    Dim New_date As String
    On Error Resume Next
    r = 1
    With FlexGrid
        If IsDate(Data_T.Text) = True Then
            New_date = .TextMatrix(Row_int, Col_int)
            .TextMatrix(Row_int, Col_int) = Format(Data_T.Text, "yyyy-mm-dd")
            If New_date <> Trim(Data_T.Text) Then
                For I = Row_int + 1 To 12
                     data_er = CDate(Val(Mid(.TextMatrix(Row_int, Col_int), 1, 4)) & "-" _
                                      & Val(Mid(.TextMatrix(Row_int, 1), 6, 5)))
                    .TextMatrix(I, 1) = DateAdd("m", r, data_er)
                    r = r + 1
                Next
            End If
            
        Else
            Data_T.Text = .TextMatrix(Row_int, Col_int)
        End If
         
    End With
End Sub
Private Sub FlexGrid_Scroll()
    Data_T.Visible = False
End Sub
Private Sub FlexGrid_SelChange()
    With FlexGrid
         .Col = 1
         Data_T.Move .CellLeft, .CellTop, .CellWidth, .CellHeight - 10
         Data_T.Visible = True
         Data_T.SetFocus
    End With
End Sub
Private Sub Form_Activate()
On Error GoTo ERROR_EXIT
    Dim TF As Boolean
    Dim ado_Data As New ADODB.Recordset
    Dim ado_Data1 As New ADODB.Recordset
    
    TF = False
    Set ado_Data1 = Conn_System.Execute("select * from " & Text1(0).Tag & ".dbo.Gy_kjrlb order by qsrq DESC")
    
    If ado_Data1.RecordCount <= 0 Then
    Else
        Dim I As Integer
        For I = 1 To 12
            Text2.Text = ado_Data1!KjYear + 1
            FlexGrid.TextMatrix(13 - I, 0) = 13 - I
            FlexGrid.TextMatrix(13 - I, 1) = DateAdd("YYYY", 1, ado_Data1!qsrq)
            ado_Data1.MoveNext
        Next I
    End If
    ado_Data1.Close
    
    Exit Sub
ERROR_EXIT:
    MsgBox Err.Description, 16
    Unload Me
End Sub

						