?? 賬戶科目.frm
字號:
Else
c_code(1) = CStr(code2)
End If
If IsNull(code3) Then
c_code(2) = ""
Else
c_code(2) = CStr(code3)
End If
If IsNull(code4) Then
c_code(3) = ""
Else
c_code(3) = CStr(code4)
End If
If IsNull(code5) Then
c_code(4) = ""
Else
c_code(4) = CStr(code5)
End If
If IsNull(code6) Then
c_code(5) = ""
c_code(6) = ""
Else
c_code(5) = CStr(code6)
c_code(6) = CStr(code7)
End If
For ia = 1 To 5
If WKm_Propty(c_code(0), ia) = "" Then
arco(ia) = RGB(192, 192, 192)
Else
arco(ia) = 0
End If
Next
If Switch_Mode = AS_CODE Then
sgdSubject.AddItem c_code(0) & Chr(9) & c_code(1) & Chr(9) & _
c_code(2) & Chr(9) & c_code(3) & Chr(9) & _
c_code(4) & Chr(9) & c_code(5) & Chr(9) & _
c_code(6) & Chr(9) & c_code(0) & Chr(9) & _
c_code(1) & Chr(9) & c_code(2) & Chr(9) & _
c_code(3) & Chr(9) & c_code(4) & Chr(9) & c_code(5)
Else
sgdSubject.AddItem c_code(0) & Chr(9) & c_code(1) & Chr(9) & _
c_code(2) & Chr(9) & c_code(3) & Chr(9) & _
c_code(4) & Chr(9) & c_code(5) & Chr(9) & _
c_code(6) & Chr(9) & _
KmCodeToName(c_code(0)) & Chr(9) & _
DeptCodeToName(c_code(1)) & Chr(9) & _
PersonCodeToName(c_code(2)) & Chr(9) & _
CusCodeToName(c_code(3)) & Chr(9) & _
SupCodeToName(c_code(4)) & Chr(9) & _
ItemCodeToName(c_code(5), c_code(6))
End If
For ia = 1 To 5
sgdSubject.SetCellBackColor sgdSubject.Rows - 1, ia + 7, arco(ia)
Next
End Sub
'沒有賬戶時工具欄控制
Private Sub SetRsNullTrue()
tlbAction.Buttons("add").Enabled = False
tlbAction.Buttons("del").Enabled = False
tlbAction.Buttons("save").Enabled = False
tlbAction.Buttons("copy").Enabled = False
tlbAction.Buttons("paste").Enabled = False
RsNull = True
With frmRightMenu
.mnuS_DelR.Enabled = False
.mnuS_AddR.Enabled = False
.mnuS_SaveR.Enabled = False
End With
SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub
'有賬戶時工具欄控制
Private Sub SetRsNullFalse()
tlbAction.Buttons("add").Enabled = True
tlbAction.Buttons("del").Enabled = True
tlbAction.Buttons("save").Enabled = False
tlbAction.Buttons("copy").Enabled = True
RsNull = False
With frmRightMenu
.mnuS_DelR.Enabled = True
.mnuS_AddR.Enabled = True
.mnuS_SaveR.Enabled = False
End With
SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub
'填superGrid sgdSubject
Private Sub FillSuperGrid()
Dim SQL As String
Dim rsl As New UfRecordset
Dim objAccDefBI As New U8FDBso.clsAccDefBI
Dim objDefEO As U8FDEso.EntityObject
Set objDefEO = objAccDefBI.Init(g_sDataSourceName)
Set objAccDefBI = Nothing
With lgdAccSubject
If curAccCode <> "" And .TextMatrix(.Row, 6) = txtAccdef_id.Text Then Exit Sub
curAccCode = .TextMatrix(.Row, 6)
txtAccdef_id.Text = .TextMatrix(.Row, 6)
End With
sgdSubject.Rows = 1
'sql = "SELECT fd_accset.cCode, fd_accset.cDeptCode, fd_accset.cPersonCode, fd_accset.cCusCode, fd_accset.cSupCode, fd_accset.citem_id, fd_accset.citem_class, fd_accset.mQc" _
' & " From fd_accset" _
' & " WHERE (((fd_accset.cAccID)='" & curAccCode & "'))" _
' & " Order By cCode"
SQL = "SELECT fd_accset." & objDefEO.EOS.EOMetaData("subject_code").SourceField & " as cCode, fd_accset." & objDefEO.EOS.EOMetaData("department_code").SourceField & " as cDeptCode, fd_accset." & objDefEO.EOS.EOMetaData("person_code").SourceField & " as cPersonCode, fd_accset." & objDefEO.EOS.EOMetaData("customer_code").SourceField & " as cCusCode, fd_accset." & objDefEO.EOS.EOMetaData("provider_code").SourceField & " as cSupCode, fd_accset." & objDefEO.EOS.EOMetaData("item_code").SourceField & " as citem_id, fd_accset." & objDefEO.EOS.EOMetaData("itemclass_code").SourceField & " as citem_class, fd_accset." & objDefEO.EOS.EOMetaData("debcred_flag").SourceField & " as mQc" _
& " From " & objDefEO.EOS.EOMetaData.SourceTable & " as fd_accset" _
& " WHERE " & objDefEO.EOS.EOMetaData("type_flag").SourceField & "=0 and (((fd_accset." & objDefEO.EOS.EOMetaData.ParentField & ")='" & curAccCode & "'))" _
& " Order By " & objDefEO.EOS.EOMetaData("subject_code").SourceField
Set objDefEO = Nothing
Set rsl = dbsZJ.OpenRecordset(SQL, dbOpenSnapshot)
With rsl
If .EOF Then
Set_rsnull_true
cboDebCred.Text = cboDebCred.List(0)
Exit Sub
Else
Set_rsnull_false
cboDebCred.Text = cboDebCred.List(IIf(![mQc] = 0, 0, 1))
End If
Frtin = True
While Not .EOF
sgdSubject_AddItem !cCode, !cdeptcode, !cPersonCode, !cCusCode, !cSupCode, !cItem_id, !citem_class
.MoveNext
Wend
Frtin = False
End With
set_edstatus_browse
End Sub
Private Sub Set_rsnull_true()
tlbAction.Buttons("del").Enabled = False
frmRightMenu.mnuS_DelR.Enabled = False
RsNull = True
SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub
Private Sub Set_rsnull_false()
tlbAction.Buttons("del").Enabled = True
frmRightMenu.mnuS_DelR.Enabled = True
RsNull = False
SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub
Private Sub genadd()
'If edstatus = Child_Add Then Exit Sub
'If edstatus = Child_Add Or edstatus = Child_Edit Then Exit Sub
set_edstatus_add
ReDim ColorArray(12)
Dim i
For i = 0 To 12
ColorArray(i) = COLOR_WHITE
Next i
With frmAccSet.sgdSubject
.AddRecord "", ColorArray
End With
End Sub
Private Sub set_edstatus_add()
edstatus = Child_Add
End Sub
Private Sub set_edstatus_browse()
tlbAction.Buttons("add").Enabled = True
tlbAction.Buttons("del").Enabled = True
frmRightMenu.mnuS_DelR.Enabled = True
frmRightMenu.mnuS_AddR.Enabled = True
edstatus = Child_Borwse
SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub
Private Sub set_edstatus_edit()
edstatus = Child_Edit
End Sub
Private Sub GenExit()
Unload Me
End Sub
Private Sub GenDel()
If sgdSubject.Rows = 1 Then
MsgBox "沒有可刪除記錄!", vbInformation, zjGl_Name
Exit Sub
End If
With frmAccSet
' If .sgdSubject.ProtectUnload = dbRetry Then Exit Sub
If sgdSubject.Rows = 1 Then Exit Sub
If sgdSubject.TextMatrix(sgdSubject.Row, 0) <> "" Then
If MsgBox("請確認是否刪除此賬戶科目?", vbQuestion + vbOKCancel, zjGl_Name) = vbCancel Then Exit Sub
End If
tlbAction.Buttons("save").Enabled = True
frmRightMenu.mnuS_SaveR.Enabled = True
.sgdSubject.RemoveItem .sgdSubject.Row
If .sgdSubject.Rows = 1 Then
Set_rsnull_true
Else
Set_rsnull_false
End If
End With
set_edstatus_browse
End Sub
Private Sub cboDebCred_Click()
If sgdSubject.Rows > 1 Then
tlbAction.Buttons("save").Enabled = True
frmRightMenu.mnuS_SaveR.Enabled = True
SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End If
End Sub
Public Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyP '打印
If Shift = 2 Then
Gen_Key "Print"
KeyCode = 0
End If
Case vbKeyS '預覽
'cuidong 2001.01.15
'If Shift = 2 Then
' Gen_Key "Preview"
' KeyCode = 0
'End If
Case vbKeyW '預覽
If Shift = 2 Then
Gen_Key "Dataout"
KeyCode = 0
End If
Case vbKeyF5
If Shift = 0 Then
Gen_Key "add"
End If
Case vbKeyY
If Shift = 2 And tlbAction.Buttons("del").Enabled Then
Gen_Key "del"
KeyCode = 0
End If
Case vbKeyF6
If Shift = 0 And tlbAction.Buttons("save").Enabled Then
Gen_Key "save"
End If
Case vbKeyF8
If Shift = 0 Then
Gen_Key "switch"
End If
Case vbKeyR
If Shift = 2 Then
Gen_Key "refresh"
KeyCode = 0
End If
Case vbKeyC
If Shift = 2 And tlbAction.Buttons("copy").Enabled Then
Gen_Key "copy"
KeyCode = 0
End If
Case vbKeyV
If Shift = 2 And tlbAction.Buttons("paste").Enabled Then
Gen_Key "paste"
KeyCode = 0
End If
Case vbKeyF4
If Shift = 2 Then
Gen_Key "exit"
End If
End Select
SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub
Private Sub Form_Load()
Screen.MousePointer = vbHourglass
Me.width = 9300
Me.Height = 5715
Me.Icon = LoadResPicture(109, vbResIcon)
CenterForm Me
'ImageList_Initialize ilsTlb1
MSImageList_Initialize ilsTlb
MSToolBar_Initialize tlbAction, "Print", TB_PRINT
MSToolBar_Initialize tlbAction, "Preview", TB_PREVIEW
MSToolBar_Initialize tlbAction, "Export", TB_Export
MSToolBar_Initialize tlbAction, "add", TB_ADD
MSToolBar_Initialize tlbAction, "del", TB_DEL
MSToolBar_Initialize tlbAction, "copy", TB_COPY
MSToolBar_Initialize tlbAction, "paste", TB_PASTE
MSToolBar_Initialize tlbAction, "save", TB_Save
MSToolBar_Initialize tlbAction, "switch", TB_SWITCH
MSToolBar_Initialize tlbAction, "refresh", TB_Refresh
MSToolBar_Initialize tlbAction, "help", TB_HELP
MSToolBar_Initialize tlbAction, "exit", TB_EXIT
SetTlbStyle Me, False
ocxCtbTool.RefreshEnable
cboDebCred.AddItem "借方"
cboDebCred.AddItem "貸方"
SetPrintDataStyleXML_flag = False
With frmAccSet.lgdAccSubject
.Cols = 7
.GrdKeyCol = 1
.Row = 0
.col = 0
.GrdText = "單位名稱"
.ColWidth(0) = 2000
.ColAlignment(0) = 1
.FixedAlignment(0) = 4
.Row = 0
.col = 1
.GrdText = "賬戶號"
.ColWidth(1) = 2000
.ColAlignment(1) = 1
.FixedAlignment(1) = 4
.Row = 0
.col = 2
.GrdText = "賬戶名"
.ColWidth(2) = 2500
.ColAlignment(2) = 1
.FixedAlignment(2) = 4
.Row = 0
.col = 3
.GrdText = "利率"
.ColWidth(3) = 830
.ColAlignment(3) = 1
.FixedAlignment(3) = 4
.Row = 0
.col = 4
.GrdText = "類型"
.ColWidth(4) = 465
.ColAlignment(4) = 4
.FixedAlignment(4) = 4
.Row = 0
.col = 5
.GrdText = "標志"
.ColWidth(5) = 465
.ColAlignment(5) = 4
.FixedAlignment(5) = 4
.Row = 0
.col = 6
.GrdText = "ID"
.ColWidth(6) = 0
.ColAlignment(6) = 4
.FixedAlignment(6) = 4
.Rows = 2
.RowHeight(0) = 300
End With
With frmAccSet.sgdSubject
.RowHeight(0) = 400
.Cols = 13
.FixedCols = 7
.ColWidth(0) = 0
.ColWidth(1) = 0
.ColWidth(2) = 0
.ColWidth(3) = 0
.ColWidth(4) = 0
.ColWidth(5) = 0
.ColWidth(6) = 0
.ColWidth(7) = 2025
.ColWidth(8) = 1815
.ColWidth(9) = 1815
.ColWidth(10) = 1815
.ColWidth(11) = 1815
.ColWidth(12) = 1815
.FixedAlignment(7) = 4
.FixedAlignment(8) = 4
.FixedAlignment(9) = 4
.FixedAlignment(10) = 4
.FixedAlignment(11) = 4
.FixedAlignment(12) = 4
.ColAlignment(7) = 1
.ColAlignment(8) = 1
.ColAlignment(9) = 1
.ColAlignment(10) = 1
.ColAlignment(11) = 1
.ColAlignment(12) = 1
Switch_Mode = AS_CODE
SupGrd_Switch Switch_Mode
Dim i As Long
For i = 7 To 12
.SetColProperty i, 20, UserBrowButton, EditStr
Next i
.AddDisColor RGB(192, 192, 192)
End With
load_data
Screen.MousePointer = vbDefault
Me.Show
End Sub
Private Sub SupGrd_Switch(mode As SwitchMode)
With sgdSubject
If Switch_Mode = AS_CODE Then
.TextMatrix(0, 7) = "科目編碼"
.TextMatrix(0, 8) = "部門編碼"
.TextMatrix(0, 9) = "個人編碼 "
.TextMatrix(0, 10) = "客戶編碼"
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -