?? 單位批量引入.frm
字號:
Private Sub cmdSave_Click()
Save
End Sub
Private Sub cmdHelp_Click()
SendKeys "{F1}"
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub Form_Load()
CenterForm Me
Bk_Initialize
JackSize_Initialize
treSelInitialize
treUnSelInitialize
'Me.Icon = LoadResPicture(109, vbResIcon)
'ImageList_Initialize ilsTree
End Sub
Private Sub Bk_Initialize()
Dim i As Integer
For i = 0 To 5
bk(i).Move 210, 720
Next i
CurrentTab = 0
End Sub
Private Sub Tree_Initialize(tre As MSComctlLib.TreeView)
tre.Nodes.Clear
tre.Nodes.Add , , "K0", "個人"
tre.Nodes.Add , , "K1", "部門"
tre.Nodes.Add , , "K2", "銀行"
tre.Nodes.Add , , "K3", "客戶"
tre.Nodes.Add , , "K4", "供應商"
tre.Nodes.Add , , "K5", "項目"
tre.LineStyle = tvwRootLines
tre.Style = tvwTreelinesPlusMinusPictureText
tre.LabelEdit = tvwManual
Dim i As Integer
For i = 1 To treUnSel.Nodes.Count
If treUnSel.Nodes(i).Children > 0 Then
treUnSel.Nodes(i).Image = 1
Else
treUnSel.Nodes(i).Image = 3
End If
Next
End Sub
Private Sub treSelInitialize()
Dim objAccUnitBI As New U8FDBso.clsAccUnitBI
Dim objEO As U8FDEso.EntityObject
Dim objOID As New U8FDEso.OIDObject
Me.treSel.Nodes.Add , , "K0", "個人"
Me.treSel.Nodes.Add , , "K1", "部門"
Me.treSel.Nodes.Add , , "K2", "銀行"
Me.treSel.Nodes.Add , , "K3", "客戶"
Me.treSel.Nodes.Add , , "K4", "供應商"
Me.treSel.Nodes.Add , , "K5", "項目"
Me.treSel.LineStyle = tvwRootLines
Me.treSel.Style = tvwTreelinesPlusMinusPictureText
Me.treSel.LabelEdit = tvwManual
Set objEO = objAccUnitBI.MoveTo(g_sDataSourceName, U8FDEso.esoFirst, m_conBIStyle)
Dim i As Integer, RecordCount As Long
RecordCount = objAccUnitBI.RecordCount(g_sDataSourceName, objEO)
For i = 1 To RecordCount
Me.treSel.Nodes.Add "K" & objEO("type_flag"), tvwChild, "K" & objEO("type_flag") & objEO("accunit_id"), objEO("accunit_code")
objOID = objEO("accunit_id")
Set objEO = objAccUnitBI.MoveTo(g_sDataSourceName, U8FDEso.esoNext, m_conBIStyle, objOID)
Next
For i = 1 To treSel.Nodes.Count
If treSel.Nodes(i).Children > 0 Then
treSel.Nodes(i).Image = 1
Else
treSel.Nodes(i).Image = 3
End If
Next
Set objAccUnitBI = Nothing
Set objOID = Nothing
Set objEO = Nothing
End Sub
Private Sub treUnSelInitialize()
Me.treUnSel.Nodes.Add , , "K0", "個人"
Me.treUnSel.Nodes.Add , , "K1", "部門"
Me.treUnSel.Nodes.Add , , "K2", "銀行"
Me.treUnSel.Nodes.Add , , "K3", "客戶"
Me.treUnSel.Nodes.Add , , "K4", "供應商"
Me.treUnSel.Nodes.Add , , "K5", "項目"
Me.treUnSel.LineStyle = tvwRootLines
Me.treUnSel.Style = tvwTreelinesPlusMinusPictureText
Me.treUnSel.LabelEdit = tvwManual
Dim i As Integer
For i = 1 To treUnSel.Nodes.Count
If treUnSel.Nodes(i).Children > 0 Then
treUnSel.Nodes(i).Image = 1
Else
treUnSel.Nodes(i).Image = 3
End If
Next
End Sub
Private Sub DataInput(iType As Integer)
Dim SQL As String
Select Case iType
Case 0
SQL = "select cPersonCode,cPersonName " & "from Person " & "order by cPersonCode"
Case 1
SQL = "select cDepCode,cDepName " & "from DepartMent Where Not bDepEnd=0 " & "order by cDepCode"
Case 2
SQL = "select cBCode,cBName " & "from Bank " & "order by cBCode"
Case 3
SQL = "select cCusCode,cCusAbbName " & "from Customer " & "order by cCusCode"
Case 4
SQL = "select cVenCode,cVenAbbName " & "from Vendor " & "order by cVenCode"
Case 5
SQL = "select citem_class from fitem where citem_class>='00' and citem_class<='99' order by citem_class"
End Select
lvwSel(CurrentTab).ListItems.Clear
ListView_Load lvwUnSel(CurrentTab), SQL
Set_lvwUnSel_Null_False CurrentTab
End Sub
Private Sub ListView_Load(lvw As ListView, SQL As String)
Dim con As New ADODB.Connection
Dim rec As New ADODB.Recordset, rec2 As New ADODB.Recordset
On Error Resume Next
con.Open g_sDataSourceName
lvw.ListItems.Clear
If Right(SQL, 5) = "class" Then
rec.Open SQL, con, adOpenStatic, adLockOptimistic
With rec
While Not .EOF
SQL = "select '" & rec!citem_class & "' + [citemcode] as zd1,[citemname] from fitemss" & rec!citem_class & " order by [citemcode]"
rec2.Open SQL, con, adOpenStatic, adLockOptimistic
If Err.Number <> 0 Then GoTo nextab
With rec2
While Not .EOF
ListView_AddItem lvw, .Fields(0).Value, .Fields(1).Value
.MoveNext
Wend
.Close
End With
nextab: .MoveNext
Wend
.Close
End With
Else
rec.Open SQL, con, adOpenStatic, adLockOptimistic
With rec
While Not .EOF
ListView_AddItem lvw, .Fields(0).Value, .Fields(1).Value
.MoveNext
Wend
.Close
End With
End If
End Sub
Private Sub ListView_AddItem(lvw As ListView, Code As String, Name As String)
Dim itm As ListItem
'lvw.Icons = ilsTlb: lvw.SmallIcons = ilsTlb
Set itm = lvw.ListItems.Add()
'itm.SmallIcon = "a"
itm.Text = Code
itm.SubItems(1) = Name
End Sub
Private Sub jkrTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button <> vbLeftButton Then Exit Sub
drag = True
StartX = jkrTree.Left
End Sub
Private Sub jkrTree_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If drag Then
If x + jkrTree.Left > maxLeft Or x + jkrTree.Left < minLeft Then Exit Sub
jkrTree.Move x + jkrTree.Left
End If
End Sub
Private Sub jkrTree_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button <> vbLeftButton Then Exit Sub
drag = False
EndX = jkrTree.Left
lblExist.Width = lblExist.Width + EndX - StartX
treSel.Width = treSel.Width + EndX - StartX
lblInput.Left = lblInput.Left - StartX + EndX
lblInput.Width = lblInput.Width + StartX - EndX
treUnSel.Left = treUnSel.Left - StartX + EndX
treUnSel.Width = treUnSel.Width + StartX - EndX
End Sub
Private Sub lvwSel_DblClick(Index As Integer)
cmdSel_Click Index * 4 + 2
End Sub
Private Sub lvwUnSel_DblClick(Index As Integer)
cmdSel_Click Index * 4 + 1
End Sub
Private Sub tabImport_Click()
Dim TabIndex As Integer
With tabImport
TabIndex = .SelectedItem.Index - 1
If CurrentTab <> TabIndex Then
bk(CurrentTab).Visible = False
bk(TabIndex).Visible = True
End If
CurrentTab = .SelectedItem.Index - 1
End With
End Sub
Private Sub BeginImport()
FromLvwToTre lvwSel(0), treUnSel, "K0"
Set_lvwSel_Null_True 0
FromLvwToTre lvwSel(1), treUnSel, "K1"
Set_lvwSel_Null_True 1
FromLvwToTre lvwSel(2), treUnSel, "K2"
Set_lvwSel_Null_True 2
FromLvwToTre lvwSel(3), treUnSel, "K3"
Set_lvwSel_Null_True 3
FromLvwToTre lvwSel(4), treUnSel, "K4"
Set_lvwSel_Null_True 4
FromLvwToTre lvwSel(5), treUnSel, "K5"
Set_lvwSel_Null_True 5
End Sub
Private Sub Set_lvwSel_Null_True(Index As Integer)
cmdSel(Index * 4 + 2).Enabled = False
cmdSel(Index * 4 + 3).Enabled = False
End Sub
Private Sub Set_lvwSel_Null_False(Index As Integer)
cmdSel(Index * 4 + 2).Enabled = True
cmdSel(Index * 4 + 3).Enabled = True
End Sub
Private Sub Set_lvwUnSel_Null_False(Index As Integer)
cmdSel(Index * 4).Enabled = True
cmdSel(Index * 4 + 1).Enabled = True
End Sub
Private Sub Set_lvwUnSel_Null_True(Index As Integer)
cmdSel(Index * 4).Enabled = False
cmdSel(Index * 4 + 1).Enabled = False
End Sub
Private Sub FromLvwToTre(lvw As ListView, tre As MSComctlLib.TreeView, Key As String)
Dim Node As MSComctlLib.Node
Dim Code As String
Dim Name As String
Dim i As Integer
For i = 1 To lvw.ListItems.Count
Code = lvw.ListItems(i).Text
Name = lvw.ListItems(i).SubItems(1)
On Error Resume Next
Set Node = tre.Nodes.Add(Key, tvwChild, Key & Code, Code & Chr(9) & Name)
Node.Image = 3
Node.Parent.Image = 1
If Err > 0 Then
If Not ImportBringErrMsg(Code, Name) Then Exit Sub
On Error GoTo 0
End If
Next i
lvw.ListItems.Clear
End Sub
Private Function ImportBringErrMsg(Code As String, Name As String) As Boolean
Dim resp
resp = MsgBox("編碼: " & Code & vbCrLf & "名稱: " & Name & vbCrLf & vbCrLf & "編碼沖突,放棄引入此節點!" & vbCrLf & "是否繼續此次引入?", vbCritical + vbYesNo, g_conSysName)
If resp = vbYes Then
ImportBringErrMsg = True
Else
ImportBringErrMsg = False
End If
Err = 0
End Function
Private Sub Save()
Dim i As Long
On Error Resume Next
For i = 1 To treUnSel.Nodes.Count
If Len(treUnSel.Nodes(i).Key) > 2 Then
SaveUnit Mid(treUnSel.Nodes(i).Key, 2, 1), Mid(treUnSel.Nodes(i).Key, 3), Mid(treUnSel.Nodes(i).Text, InStr(1, treUnSel.Nodes(i).Text, Chr(9)) + 1)
End If
Next i
Tree_Initialize treUnSel
End Sub
Private Sub SaveUnit(Type_Flag As String, Code As String, Name As String)
Dim objAccUnitBI As New U8FDBso.clsAccUnitBI
Dim objEO As U8FDEso.EntityObject
Dim Key As String
Set objEO = objAccUnitBI.Init(g_sDataSourceName, m_conBIStyle)
objEO.State = U8FDEso.esoAddNew
objEO("accunit_code") = Code
objEO("accunit_name") = Name
objEO("type_flag") = CByte(Right(Type_Flag, 1))
If Not objAccUnitBI.Save(g_sDataSourceName, objEO, m_conBIStyle) Then
MsgBox "【" & Code & "," & Name & "】保存不成功!"
Else
Me.treSel.Nodes.Add "K" & Right(Type_Flag, 1), tvwChild, "K" & Right(Type_Flag, 1) & objEO("accunit_id"), Code
frmAccUnit.treStyle.Nodes.Add "K" & Right(Type_Flag, 1), tvwChild, "K" & Right(Type_Flag, 1) & objEO("accunit_id"), Code
Key = "K" & Right(Type_Flag, 1) & objEO("accunit_id")
Me.treSel.Nodes(Key).Image = 3
frmAccUnit.treStyle.Nodes(Key).Image = 3
End If
Set objEO = Nothing
Set objAccUnitBI = Nothing
End Sub
Private Sub Clear(tre As MSComctlLib.TreeView)
Tree_Initialize tre
End Sub
Private Sub JackSize_Initialize()
maxLeft = 6600
minLeft = 210
End Sub
Private Sub treSel_Collapse(ByVal Node As MSComctlLib.Node)
Node.Image = 1
End Sub
Private Sub treSel_Expand(ByVal Node As MSComctlLib.Node)
Node.Image = 2
End Sub
Private Sub treUnSel_Collapse(ByVal Node As MSComctlLib.Node)
Node.Image = 1
End Sub
Private Sub treUnSel_Expand(ByVal Node As MSComctlLib.Node)
Node.Image = 2
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -