form_datecoinfo.frm
来自「新世纪ERP系统管理源代码」· FRM 代码 · 共 670 行 · 第 1/2 页
FRM
670 行
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
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 'False
ShowComboButton = -1 'True
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = -1 'True
DataMember = ""
Begin VB.TextBox Data_T
BorderStyle = 0 'None
Height = 225
Left = 450
TabIndex = 17
Top = 270
Visible = 0 'False
Width = 1335
End
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "数量小数位数:"
Height = 180
Left = -74160
TabIndex = 20
Top = 1890
Width = 1170
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "金额小数位数:"
Height = 180
Left = -74160
TabIndex = 19
Top = 1410
Width = 1170
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "单价小数位数:"
Height = 180
Left = -74160
TabIndex = 18
Top = 870
Width = 1170
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "启用会计期间:"
Height = 180
Left = -72180
TabIndex = 16
Top = 1950
Width = 1170
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "当前会计年度:"
Height = 180
Left = -72180
TabIndex = 15
Top = 1230
Width = 1170
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "电话:"
Height = 180
Index = 2
Left = 300
TabIndex = 4
Top = 1740
Width = 450
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "地址:"
Height = 180
Index = 1
Left = 300
TabIndex = 3
Top = 1260
Width = 450
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "公司名称:"
Height = 180
Index = 0
Left = 300
TabIndex = 2
Top = 810
Width = 810
End
End
End
Attribute VB_Name = "Frm_DateCoInfo"
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 Check1_Click()
Dim i As Integer
If Check1.Value = 1 Then
For i = 1 To 12
FlexGrid.TextMatrix(i, 0) = i
FlexGrid.TextMatrix(i, 1) = Format(Text2.Text & "-" & i & "-1", "yyyy-mm-dd")
Next i
Data_T.Locked = True
Else
Data_T.Locked = False
End If
Data_T.Text = FlexGrid.TextMatrix(FlexGrid.Row, 1)
End Sub
Private Sub Command1_Click(Index As Integer)
Dim Ssql As String
Dim i As Integer
Dim aDo_Date As New Recordset
On Error GoTo error_exit
If Index = 1 Then Unload Me: Exit Sub
Ssql = "update HDSystem_DataBases set CoName='" & Trim(Text1(0).Text) & "'," _
& "Address='" & Trim(Text1(1).Text) & "',Phone='" & Trim(Text1(2).Text) & "',qsqj=" & Val(Text3.Text) _
& " WHERE DataBasesName='" & Trim(Text1(0).Tag) & "'"
Conn_System.Execute Ssql
Conn_System.Execute "delete " & Trim(Text1(0).Tag) & ".dbo.Gy_kjrlb"
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
If Val(FlexGrid.TextMatrix(i, 0)) < Val(Text3.Text) Then
!cwzzjzbz = 1: !Xsjzbz = 1
!Gdzcjzbz = 1: !Kfjzbz = 1
!chhsjzbz = 1: !PMjzbz = 1
!CgJzbz = 1: !CaskJzbz = 1
End If
If Val(FlexGrid.TextMatrix(i, 0)) = Val(Text3.Text) Then
!beginflag = 1
End If
.Update
Next
.UpdateBatch adAffectAllChapters
.Close
Set aDo_Date = Nothing
End With
Conn_System.Execute "update " & Text1(0).Tag & ".dbo.Gy_AccInformation set itemValue=" & DJ_Text.Text & " where systemcode='Cwzz' and itemcode='cwdjxsws'"
Conn_System.Execute "update " & Text1(0).Tag & ".dbo.Gy_AccInformation set itemValue=" & JE_Text.Text & " where systemcode='Cwzz' and itemcode='cwjexsws'"
Conn_System.Execute "update " & Text1(0).Tag & ".dbo.Gy_AccInformation set itemValue=" & SL_Text.Text & " where systemcode='Cwzz' and itemcode='cwslxsws'"
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 Recordset
Dim aDo_data1 As New Recordset
TF = False
Set aDo_data = Conn_System.Execute("select * from HDSystem_DataBases where DataBasesName='" & Text1(0).Tag & "'")
If aDo_data.RecordCount > 0 Then
Text1(0) = "" & aDo_data!CoName
Text1(1) = "" & aDo_data!Address
Text1(2) = "" & aDo_data!Phone
Text3.Text = IIf(Val("" & aDo_data!qsqj) = 0, 1, aDo_data!qsqj)
Text2.Text = Year(Date)
If Trim(aDo_data!YNUse) = "1" Then
Command1(0).Enabled = False
End If
End If
aDo_data.Close
Set aDo_data = Nothing
Set aDo_data1 = Conn_System.Execute("select * from " & Text1(0).Tag & ".dbo.Gy_kjrlb order by Kjyear,Period")
If aDo_data1.RecordCount <= 0 Then
Check1.Value = 1
Check1_Click
Else
Dim i As Integer
For i = 1 To 12
Text2.Text = aDo_data1!KjYear
FlexGrid.TextMatrix(i, 0) = i
FlexGrid.TextMatrix(i, 1) = aDo_data1!qsrq
aDo_data1.MoveNext
Next i
End If
aDo_data1.Close
Set aDo_data1 = Conn_System.Execute("select * from " & Text1(0).Tag & ".dbo.Gy_AccInformation where systemcode='Cwzz'")
With aDo_data1
Do While Not .EOF
Select Case Trim(!itemcode)
Case "cwdjxsws"
DJ_Text.Text = !itemValue
Case "cwjexsws"
JE_Text.Text = !itemValue
Case "cwslxsws"
SL_Text.Text = !itemValue
End Select
aDo_data1.MoveNext
Loop
aDo_data1.Close
Set aDo_data1 = Nothing
End With
Exit Sub
error_exit:
MsgBox Err.Description, 16
Unload Me
End Sub
Private Sub Text2_Change()
Dim i As Integer
For i = 1 To 12
FlexGrid.TextMatrix(i, 1) = Format(Trim(Text2.Text) & "- " & i & "-01", "yyyy-mm-dd")
Next i
Data_T.Text = FlexGrid.TextMatrix(FlexGrid.Row, 1)
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?