?? 項目向導.frm
字號:
End
Begin VB.ListBox lstXdkm
Height = 1140
Left = 990
Sorted = -1 'True
TabIndex = 35
Top = 2130
Width = 2805
End
Begin VB.ListBox lstDxkm
Height = 960
Left = 990
Sorted = -1 'True
TabIndex = 34
Top = 690
Width = 2805
End
Begin VB.ComboBox cobXmmc
Height = 300
Left = 990
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 33
Top = 270
Width = 2505
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "選定科目"
Height = 180
Left = 180
TabIndex = 42
Top = 2190
Width = 720
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "待選科目"
Height = 180
Left = 180
TabIndex = 41
Top = 720
Width = 720
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "項目名稱"
Height = 180
Left = 180
TabIndex = 40
Top = 330
Width = 720
End
End
Begin VB.Frame bk
Height = 3500
Index = 1
Left = 2600
TabIndex = 28
Top = 240
Width = 4200
Begin EDITLib.Edit edtXmmc
Height = 270
Left = 1140
TabIndex = 1
Top = 690
Width = 1905
_Version = 65536
_ExtentX = 3360
_ExtentY = 476
_StockProps = 253
ForeColor = 0
BackColor = 16777215
Appearance = 1
MaxLength = 20
BadStr = "|'"""
End
Begin VB.Frame Frame2
Height = 30
Left = 150
TabIndex = 51
Top = 1530
Width = 3945
End
Begin VB.ComboBox cobSrc
Enabled = 0 'False
Height = 300
Left = 1140
TabIndex = 2
Text = "cobSrc"
Top = 1080
Width = 1335
End
Begin VB.ListBox lstXmml
Height = 960
Left = 330
Sorted = -1 'True
TabIndex = 6
Top = 1920
Width = 2715
End
Begin VB.CommandButton cmdOk
Caption = "確定"
Enabled = 0 'False
Height = 315
Left = 3270
TabIndex = 3
Top = 1080
Width = 615
End
Begin VB.CommandButton cmdAdd
Caption = "增加"
Height = 315
Left = 3270
TabIndex = 4
Top = 1980
Width = 615
End
Begin VB.CommandButton cmdDel
Caption = "刪除"
Height = 315
Left = 3270
TabIndex = 5
Top = 2370
Width = 615
End
Begin VB.TextBox txtXmbm
Enabled = 0 'False
Height = 270
Left = 1140
TabIndex = 0
Top = 300
Width = 1335
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "數據來源"
Height = 180
Left = 300
TabIndex = 50
Top = 1110
Width = 720
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "項目名稱"
Height = 180
Left = 300
TabIndex = 31
Top = 735
Width = 720
End
Begin VB.Label Label11
AutoSize = -1 'True
Caption = "項目目錄"
Height = 180
Left = 330
TabIndex = 30
Top = 1650
Width = 720
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "項目編碼"
Height = 180
Left = 300
TabIndex = 29
Top = 360
Width = 720
End
End
End
Attribute VB_Name = "frmItmWzd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'軟件著作權: 北京用友軟件集團有限公司
'系統名稱: 資金管理8.0
'功能說明: 項目定義向導
'作者: 趙春立
Option Explicit
Private mStep As Long
Private cGrade As String
Private bReXmLst As Boolean
Public blnRuned As Boolean
Private blnFillcob As Boolean
Private blnChangeKm As Boolean
Private blnChangeDl As Boolean
Private blnClick As Boolean
Private blnRefresh As Boolean
Private lngCobXmmc() As Long
Private lngGrade(1 To 4) As Long
Private strGrade(1 To 4) As String
Private iGrade As Long
Private blnAddOrEdit As Boolean
'**********************************************************************
'*函數說明: 驗證項目編碼的正確性 *
'*參 數: *
'* *
'*返回值 : True - 正確 *
'***********************************************************************
Private Function VerifyGrade() As Boolean
Dim i As Long, tmpGrade As Long
Dim id As Integer
VerifyGrade = False
For i = 1 To 4
tmpGrade = tmpGrade + lngGrade(i)
strGrade(i) = mID(txtXmbm, 1 + tmpGrade - lngGrade(i), lngGrade(i))
Next i
For i = 1 To 4
If strGrade(i) <> "" And lngGrade(i) <> Len(strGrade(i)) Then
MsgBox "項目編碼不符合級次定義！", vbInformation, zjGl_Name
SetTxtFocus txtXmbm
Exit Function
End If
Next i
For i = 1 To 4
If strGrade(i) = "" Then
Exit For
End If
Next i
iGrade = i - 1
VerifyGrade = True
End Function
'**********************************************************************
'*函數說明: 填充ListBox *
'*參 數: mIndex - 項目大類 *
'* *
'*返回值 : *
'***********************************************************************
Private Sub FillLst(mIndex As Integer)
Dim rsl As New UfRecordset, sqlL As String
On Error Resume Next
lResume:
sqlL = "SELECT * FROM FD_Items WHERE [iitems_id]=" & (cobDl.ListIndex + 1)
Set rsl = dbsZJ.OpenRecordset(sqlL, dbOpenSnapshot)
lstXmml.Clear
While Not rsl.EOF
lstXmml.AddItem "[" & rsl![cItem_id] & "] " & rsl![cItem_Name]
rsl.MoveNext
If Err <> 0 Then GoTo lResume
Wend
On Error GoTo 0
On Error GoTo Errsol
If lstXmml.ListCount <> 0 Then lstXmml.Selected(mIndex) = True
Exit Sub
Errsol:
mIndex = mIndex - 1
Resume
End Sub
'**********************************************************************
'*函數說明: 填充Combo *
'*參 數: *
'* *
'*返回值 : *
'***********************************************************************
Private Sub FillCob()
Dim rsC As New UfRecordset
Dim sqlC As String
Dim i As Long
Dim j As Long
sqlC = "SELECT * FROM FD_Items WHERE [bend] = 1 AND [iitems_id]=" & _
(cobDl.ListIndex + 1) & " ORDER BY [citem_id]"
Set rsC = dbsZJ.OpenRecordset(sqlC, dbOpenSnapshot)
cobXmmc.Clear
i = 0: j = 0
ReDim lngCobXmmc(2, 10)
While Not rsC.EOF
cobXmmc.AddItem "[" & rsC![cItem_id] & "]" & rsC![cItem_Name]
'1-科目；2-賬戶；0-非末級
lngCobXmmc(0, j) = IIf(rsC![bSource], 1, 2)
lngCobXmmc(1, j) = rsC![iItem_id]
j = j + 1
If j >= i + 10 Then
ReDim Preserve lngCobXmmc(2, j + 10)
i = i + 10
End If
rsC.MoveNext
Wend
If cobXmmc.ListCount <> 0 Then cobXmmc.Text = cobXmmc.List(0)
End Sub
Private Sub cmdStep_Click(Index As Integer)
Dim i As Long
Select Case Index
Case 0
If blnChangeKm Then
If Not SavKm(cobXmmc.ListIndex) Then
MsgBox "網絡互斥，請過一會兒再試！", vbInformation, zjGl_Name
End If
blnChangeKm = False
bReXmLst = True
End If
mStep = mStep - 1
cmdStep(1).Enabled = True
If mStep = 0 Then
cmdStep(0).Enabled = False
cmdStep(2).Caption = "放棄"
If lstXmml.ListCount = 0 Then
For i = 1 To 3
txtgrade(i).Locked = False
Next i
Else
For i = 1 To 3
txtgrade(i).Locked = True
Next i
End If
End If
Case 1
If mStep = 0 Then
If Not VerifyDl Then Exit Sub
ElseIf mStep = 1 Then
If bReXmLst Then
bReXmLst = False
blnFillcob = False
FillCob
End If
End If
mStep = mStep + 1
cmdStep(0).Enabled = True
cmdStep(2).Caption = "完成"
If mStep = 2 Then
cmdStep(1).Enabled = False
End If
Case 2
If blnChangeKm Then
If Not SavKm(cobXmmc.ListIndex) Then
MsgBox "網絡互斥，請過一會兒再試！", vbInformation, zjGl_Name
End If
blnChangeKm = False
End If
If cmdStep(2).Caption = "完成" Then
If blnChangeDl Then
blnChangeDl = False
SavDl cobDl.ListIndex + 1
End If
End If
frmItem.blnRefresh = blnRefresh
blnRefresh = False
Unload Me
End Select
If Index <> 2 Then
ShowSign mStep
For i = 0 To 2
If i = mStep Then
bk(i).Visible = True
Else
bk(i).Visible = False
End If
Next i
If bk(1).Visible Then
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -