+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغات البرمجة الاخرى (http://vb4arb.com/vb/forumdisplay.php?fid=4)
+--- قسم : قسم لغة vb6.0 (http://vb4arb.com/vb/forumdisplay.php?fid=18)
+---- قسم : قسم أمثلة ومشاريع vb6.0 (http://vb4arb.com/vb/forumdisplay.php?fid=30)
+---- الموضوع : [vb6.0] شجرة الحسابات (/showthread.php?tid=18771)
شجرة الحسابات - fayadus - 11-01-17
[attachment=12819]
نهدى اليكم بمناسبة السنة الميلادية الجديدة فكرة انشاء شجرة الحسابات لمنظومة المحاسبة
لانشاء دليل حسابات اخترافى لابد من تكوين فكرة مبدئية عن الموضع
لدينا فى الاساس اربعة حسابات رئيسية
- حساب الاصول
- حساب الخصوم
- حساب الايرادات
- حساب المصروفات
وتتفرع هذه الحسابات حسب نشاط كل شركة
اولا
عمل جدول فى قاعدة بيانات اكسس
اسم القاعدة data
اسم الجدول accounts
اسم الحقل نوع الحقل البيـــــــــــــــــــــــــــان
AccID نص رقم الحساب
ArAccDes نص وصف الحساب بالعربية
ParAcc نص كود الحساب الأب
ArParDes نص
IsPrimary نص
AccSort رقم
S نص
AccLevel رقم مستوى الحساب
RE: شجرة الحسابات - fayadus - 12-01-17
الاكواد
Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
On Error Resume Next
Text1.Enabled = True
Text4.Text = Val(TreeView1.SelectedItem)
Text8.Text = Val(TreeView1.SelectedItem)
Text3.Text = Val(TreeView1.SelectedItem)
Text3.SetFocus
End Sub
____________________________________________________________________________________
Private Sub TreeView1_DblClick()
On Error Resume Next
Text1.Enabled = True
Text4.Text = Val(TreeView1.SelectedItem)
Text8.Text = Val(TreeView1.SelectedItem)
Text3.Text = Val(TreeView1.SelectedItem)
Text3.SetFocus
End Sub
الكود كامل
Dim db1 As New ADODB.Connection
Dim rs2 As New ADODB.Recordset
Dim r2 As New ADODB.Recordset
Dim r3 As New ADODB.Recordset
Public Rss As New ADODB.Recordset
Dim nodX As Node
Dim rs1 As New ADODB.Recordset
Dim dbcon As ADODB.Connection
Private Sub Check1_Click()
If Check1.Value = Checked Then
Frame1.Visible = True
Else
Frame1.Visible = False
End If
End Sub
Private Sub Combo3_KeyUp(KeyCode As Integer, Shift As Integer)
On Error Resume Next
Select Case KeyCode
Case 32, &H30 To &H6F, Is > &H7F
ComboBoxSpeedFill Combo3
End Select
End Sub
Private Sub Combo3_LostFocus()
On Error Resume Next
If DB.State = adStateOpen Then DB.Close
DB.Provider = "Microsoft.JET.OLEDB.4.0;"
DB.Open "provider=microsoft.jet.oledb.4.0;data source =" & App.Path + "\data.mdb;Jet OLEDB
atabase Password=111966"If r2.State = adStateOpen Then r2.Close
r2.Open "select * From Accounts WHERE ArAccDes = '" & Trim(Combo3.Text) & "'", db1
On Error Resume Next
If r2.EOF Then
msgbox "هذا الحساب غير موجود ،،،يرجى التأكد من رقم الحساب"
Exit Sub
End If
If Not r2![accid] = "" Then Text3.Text = r2![accid] 'اسم الحساب
If r3.State = adStateOpen Then r3.Close
r3.Open "select * From Accounts WHERE ParAcc = '" & Trim(Text3.Text) & "' order by Accid DESC", db1
rb = r3![accid]
If rb = 0 Then
Text1 = Text3 & 1
Text5.Text = r2![ACCLEVEL] + 1
Else
Text1 = rb + 1
Text5.Text = r2![ACCLEVEL] + 1
End If
r2.Close
r3.Close
Text2.SetFocus
End Sub
Private Sub Combo4_Click()
Label11.Caption = ""
If Combo4.Text = "تعريفات" Then
Label11.Caption = " الحساب الرئسى هو الحساب الذى يحتوى على حسابات فرعية ويحمل كحد اقصى 999 حسابات اما الحساب الفرعى هو الحساب النهائى الذى تتم علية عملية تسجيل القيد وكل حساب فرعى يحتوى على 10000 حساب كحد اقصى "
ElseIf Combo4.Text = "اضافة حساب رئسى" Then
Label11.Caption = " لاضافة حساب رئيسى اولا نختار رقم الحساب من شجرة الحسابات وذلك بالنقر على رقم الحساب مرتين سيظهر رقم الحساب فى خانة الحساب الاب ثم نؤشر على اضافة حساب رئسى ثم الانتقال بالانتر مع مراعاة تحديد جهة قفل الحساب ثم الاستمرار بالنقر على مفتاخ الانتر الى ان تظهر رسالة تفيد بحفظ الحساب"
ElseIf Combo4.Text = "اضافة حساب فرعى" Then
Label11.Caption = " لاضافة حساب فرعى اولا نختار رقم الحساب من شجرة الحسابات وذلك بالنقر على رقم الحساب مرتين سيظهر رقم الحساب فى خانة الحساب الاب ثم نؤشر على اضافة حساب فرعى ثم الانتقال بالانتر مع مراعاة تحديد جهة قفل الحساب ثم الاستمرار بالنقر على مفتاخ الانتر الى ان تظهر رسالة تفيد بحفظ الحساب علما بأن الحساب الفرعى لايمكن اضافة حسابات تحتة بالدليل"
ElseIf Combo4.Text = "تعديل حساب " Then
Label11.Caption = " انقر على مفتاح تعديل يظهر مربع حوار فى الاعلى اختار من الشجرة الحساب المراد تعديلة سيظهر رقم الحساب فى خانة رقم الحساب المراد تعديلة ايمكنك تعديل اسم الحساب وتوجية الحساب فقط وبعد كتابة الاسم المعدل انقر على مفتاح حفظ التعديلات "
ElseIf Combo4.Text = "حذف حساب" Then
Label11.Caption = "ملاحظات لايمكن حذف الحسابات الرئيسية كما لايمكن حذف حساب تم عمل قيود عليه لاجراء عملية الحذف انقر على مفتاح حذف سيظهر مربع حوار بالاعلى اختار رقم الحساب من الشجرة ثم انقر على مفتاح تنفيذ الحذف "
End If
End Sub
Private Sub Command1_Click()
On Error Resume Next
If op1.Value = False And op2.Value = False Then
msgbox "اختار نوع الحساب من اعلى القائمة م/رئيسى / فرع"
Exit Sub
End If
If Text2.Text = "" Then
msgbox " ادخل اسم الحساب"
Text2.SetFocus
Exit Sub
End If
PoolConnection
SQLs = " Select * From Accounts WHERE accid = '" & Text1.Text & "' "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
If rs.EOF Then
GoTo OkAddNEW:
Exit Sub
End If
OkAddNEW:
If msgbox(" أنت متأكد ..تريد الحفظ ?", vbQuestion + vbMsgBoxRight + vbYesNo, " Save Data ") = vbNo Then Exit Sub
rs.AddNew
If Not Text1 = "" Then rs![accid] = Trim(Text1) 'اسم الحساب
If Not Text2 = "" Then rs![ARACCDES] = Trim(Text2) 'اسم الحساب
If Not Text3 = "" Then rs![ParAcc] = Text3 'كود حساب اب
If Not Text5 = "" Then rs![ACCLEVEL] = Text5 'المستوى
If Not Text6 = "" Then rs![Budget] = Text6 'الموازنه'
If Not TEXT22 = "" Then rs![ISPRIMARY] = TEXT22 'هل الحساب رئيسي
If Not Combo1 = "" Then rs![s] = Combo1 'طبيعة الحساب
If Not Combo2 = "" Then rs![X] = Combo2 'نوع الحساب
If Not Text7 = "" Then rs![accsort] = Text7 'ملاحظات
If Not Text55 = "" Then rs![notes] = Text55 'ملاحظات
rs.Update
TreeView1.Refresh
msgbox " تمت عملية الحفظ بنجاح ", vbInformation + vbMsgBoxRight, " Save "
Text3.Text = ""
Combo3.Text = ""
Text1.Text = ""
Text1.Text = ""
Text2.Text = ""
Text5.Text = ""
' Text55.Text = ""
Combo1.Text = ""
Combo2.Text = ""
' Text7.Text = ""
Text3.SetFocus
TreeView1.Refresh
Form_Load
End Sub
Private Sub Command3_Click()
On Error Resume Next
Set rs11 = DB.Execute("select * from [monsha] ")
DataReport2.Sections("section4").Controls("l1").Caption = rs11!Name
DataReport2.Sections("section4").Controls("l2").Caption = rs11!Add
DataReport2.Sections("section4").Controls("l3").Caption = rs11!adress
DataReport2.Sections("section4").Controls("l4").Caption = rs11!wib
DataReport2.Sections("section4").Controls("l5").Caption = rs11!email
DataReport2.Sections("section4").Controls("l6").Caption = rs11!tel & " - " & rs11!tel
PoolConnection
Adodc1.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source =" & App.Path + "\data.mdb;Jet OLEDB
atabase Password=111966"SQLs = "SELECT * from accounts order by accid,paracc"
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
Adodc1.RecordSource = SQLs
Adodc1.Refresh
Set DataReport2.DataSource = Adodc1
DataReport2.Show 1
End Sub
Private Sub Command4_Click()
Frame3.Visible = False
Frame2.Visible = True
Frame2.Top = 1320
Frame2.Left = 10920
Combo3.Enabled = True
Text1.Enabled = False
TEXT22.Enabled = True
Text4.SetFocus
End Sub
Private Sub err_Click()
End Sub
Private Sub Command5_Click()
On Error Resume Next
If Text8.Text = "" Then
msgbox "ادخل رقم الحساب"
Text8.SetFocus
Exit Sub
End If
PoolConnection
'If Text5.Text = 1 Then
'msgbox " لايمكن الاضافة بهذا المستوى "
'Exit Sub
'End If
SQLs = " Select * From Accounts WHERE accid = '" & Text8.Text & "' "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
If Not rs.EOF Then
If msgbox(" أنت متأكد ..تريد التعديل ?", vbQuestion + vbMsgBoxRight + vbYesNo, " Save Data ") = vbNo Then Exit Sub
If Not Text1 = "" Then rs![accid] = Trim(Text1) 'اسم الحساب
If Not Text2 = "" Then rs![ARACCDES] = Trim(Text2) 'اسم الحساب
'If Not text3 = "" Then rs![ParAcc] = text3 'كود حساب اب
'If Not Text5 = "" Then rs![ACCLEVEL] = Text5 'المستوى
'If Not Text6 = "" Then rs![Budget] = Text6 'الموازنه'
'rs![ISPRIMARY] = Text22 'هل الحساب رئيسي
'If Not Combo1 = "" Then rs![S] = Combo1 'طبيعة الحساب
If Not Combo2 = "" Then rs![X] = Combo2 'نوع الحساب
'If Not text7 = "" Then rs![accsort] = text7 'ملاحظات
'If Not Text55 = "" Then rs![notes] = Text55 'ملاحظات
rs.Update
msgbox " تمت عملية التعديل بنجاح ", vbInformation + vbMsgBoxRight, " Edit "
Command5.Enabled = False
End If
Text3.Enabled = False
Text1.Enabled = False
Combo3.Enabled = True
Text1.Enabled = False
Text5.Enabled = True
TEXT22.Enabled = True
command1.Enabled = True
Frame3.Visible = False
Form_Load
End Sub
Private Sub Command6_Click()
On Error Resume Next
Frame3.Visible = True
Frame3.Top = 1320
Frame3.Left = 10920
Command5.Enabled = True
Frame2.Visible = False
command1.Enabled = False
Text3.Enabled = False
Text1.Enabled = False
Combo3.Enabled = False
Text1.Enabled = False
Text5.Enabled = False
TEXT22.Enabled = False
Text8.SetFocus
End Sub
Private Sub Command8_Click()
On Error Resume Next
PoolConnection
If Text3.Text = "" Then
msgbox "ادخل رقم الحساب الاب "
Exit Sub
End If
Text7.Text = ""
Text55.Text = ""
SQLs = " Select max(accounts.accsort)as sort1 From accounts "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
Text7.Text = Val(rs!sort1) + 1
'____________________________________________
SQLs = " Select max(accounts.accsort)as sort2 From accounts where accid = '" & Text3.Text & "' "
If rs1.State = adStateOpen Then rs1.Close
rs1.Open SQLs, DB, adOpenKeyset, adLockPessimistic
Text55.Text = Val(rs1!sort2)
End Sub
Private Sub Form_Activate()
On Error Resume Next
PoolConnection
Combo2.Clear
sql = "select * From TOPACC "
If rs.State = adStateOpen Then rs.Close
rs.Open sql, DB, adOpenKeyset, adLockPessimistic
Dim n
Dim i
n = rs.RecordCount
For i = 1 To n
Combo2.AddItem rs![HEADACC]
rs.MoveNext
Next i
Form_Load
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = 13 Then Call SendKeys("{Tab}")
End Sub
Private Sub Form_Load()
On Error Resume Next
Grid1.AllowUserSort = True
On Error Resume Next
PoolConnection
' Set dbs = CurrentDb
SQLs = " Select * From Accounts "
If rs2.State = adStateOpen Then rs2.Close
rs2.Open SQLs, DB, adOpenKeyset, adLockPessimistic
' Set rst = DB.OpenRecordset("Accounts", dbOpenDynaset)
Set nodX = TreeView1.Nodes.Add(, , "A", "دليل حسابات/" & Form1.Label21.Caption)
nodX.ForeColor = &HC00000
nodX.BackColor = &HB9F9EE
With rs2
Do While Not .EOF
Set nodX = TreeView1.Nodes.Add("A" & CStr(Nz(!ParAcc)), tvwChild, "A" & CStr(!accid), CStr(!accid) & ":" & !ARACCDES)
nodX.EnsureVisible
.MoveNext
Loop
End With
rs2.Close
Set DB = Nothing
For Each nodX In TreeView1.Nodes
nodX.Expanded = False
nodX.Sorted = True
nodX.Image = ImageList1
Next
'-------تحميل قاعدة البيانات -----------
db1.CursorLocation = adUseClient
db1.Provider = "Microsoft.JET.OLEDB.4.0;"
db1.Open "provider=microsoft.jet.oledb.4.0;data source =" & App.Path + "\data.mdb;Jet OLEDB
atabase Password=111966"'-------تعبئة combo3 -----------
If rs2.State = adStateOpen Then rs2.Close
rs2.Open "select * From Accounts WHERE IsPrimary ='" & 1 & "' order by Accid ASC", db1
Do While Not rs2.EOF
Combo3.AddItem rs2![ARACCDES]
rs2.MoveNext
Loop
rs2.Close
'-*------------------------
db1.CursorLocation = adUseClient
db1.Provider = "Microsoft.JET.OLEDB.4.0;"
db1.Open "provider=microsoft.jet.oledb.4.0;data source =" & App.Path + "\data.mdb;Jet OLEDB
atabase Password=111966"'PushButton2_Click
TreeView1.Refresh
'...................................................
End Sub
Private Sub save_Click()
End Sub
Private Sub Command7_Click()
On Error Resume Next
Grid1.Column(1).UserSortIndicator = cellSortIndicatorDescending
Grid1.Column(2).UserSortIndicator = cellSortIndicatorDescending
'Main Report Title
Set objReportTitle = New FlexCell.ReportTitle
objReportTitle.Text = "الدليل المحاســـبى"
objReportTitle.Font.Name = "tohama"
objReportTitle.Font.Size = 20
objReportTitle.PrintOnAllPages = True
Grid1.ReportTitles.Add objReportTitle
'Report Title 1
Set objReportTitle = New FlexCell.ReportTitle
objReportTitle.Text = "Account Name" & " Account No: "
objReportTitle.Font.Name = "tohama"
objReportTitle.Font.Size = 16
objReportTitle.Font.Underline = True
objReportTitle.PrintOnAllPages = True
objReportTitle.Font.Italic = True
objReportTitle.Color = RGB(128, 0, 0)
objReportTitle.Align = CellLeft
Grid1.ReportTitles.Add objReportTitle
Grid1.PrintPreview
command7.Enabled = False
End Sub
Private Sub Frame2_DblClick()
Frame2.Visible = False
End Sub
Private Sub Frame3_DblClick()
Frame3.Visible = False
Combo3.Enabled = True
Text1.Enabled = False
Text5.Enabled = True
TEXT22.Enabled = True
command1.Enabled = True
End Sub
Private Sub Image2_Click()
Me.Hide
End Sub
Private Sub Image3_Click()
Me.Hide
End Sub
Private Sub Label11_DblClick()
Frame1.Visible = False
End Sub
Private Sub op1_Click()
On Error Resume Next
PoolConnection
If Text3.Text = "" Then Exit Sub
sql = "Select accounts.ISPRIMARY From [accounts] where ACCID= '" & Text3.Text & "' "
If Rss.State = adStateOpen Then Rss.Close
Rss.Open sql, DB, adOpenKeyset, adLockPessimistic
If Rss!ISPRIMARY = 2 Then
Text3.SetFocus
Text3.Text = ""
msgbox " لايمكن اضافة حساب رئيسى تحت الحساب الفرعى"
Exit Sub
End If
If op1.Value = True Then
Text3.Enabled = True
Text1.Enabled = False
Text3.SetFocus
End If
Combo3.Text = ""
Text1.Text = ""
Text1.Text = ""
Text2.Text = ""
Text5.Text = ""
Combo1.Text = ""
TEXT22.Text = 1
Command8_Click
End Sub
Private Sub op2_Click()
On Error Resume Next
PoolConnection
If Text3.Text = "" Then Exit Sub
sql = "Select accounts.ISPRIMARY From [accounts] where ACCID= '" & Text3.Text & "' "
If Rss.State = adStateOpen Then Rss.Close
Rss.Open sql, DB, adOpenKeyset, adLockPessimistic
If Rss!ISPRIMARY = 2 Then
Text3.SetFocus
Text3.Text = ""
msgbox " لايمكن اضافة حساب فرعى تحت الحساب الفرعى"
Exit Sub
End If
If op2.Value = True Then
Text3.Enabled = True
Text1.Enabled = False
Text3.SetFocus
End If
Combo3.Text = ""
Text1.Text = ""
Text1.Text = ""
Text2.Text = ""
Text5.Text = ""
Combo1.Text = ""
Text7.Text = ""
Text55.Text = ""
TEXT22.Text = 2
If Text3.Text = "" Then
msgbox "ادخل رقم الحساب الاب "
Exit Sub
End If
SQLs = " Select max(accounts.accsort)as sort2 From accounts where accid = '" & Text3.Text & "' "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
Text55.Text = Val(rs!sort2)
Text7.Text = 0
End Sub
Private Sub Option1_Click()
End Sub
Private Sub OsenXPButton1_Click()
On Error Resume Next
Grid1.Visible = True
Grid1.Cell(0, 1).Text = "اسم الحساب"
Grid1.Cell(0, 2).Text = "رقم الحساب "
Grid1.Column(1).Width = 400
Grid1.Column(2).Width = 140
Grid1.Column(0).Width = 50
Grid1.Rows = 1
PoolConnection
SQLs = "Select accounts.araccdes ,accounts.accid From [accounts] "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
Dim n
Dim i
If rs.RecordCount < 1 Then Exit Sub
rs.MoveLast
rs.MoveFirst
n = rs.RecordCount
'Grid1.Rows = n - 1
''===========================
For i = 1 To n
Grid1.AddItem rs!ARACCDES & vbTab & rs!accid
rs.MoveNext
Next i
End Sub
Private Sub OsenXPButton2_Click()
On Error Resume Next
If Grid1.ExportToExcel("") Then
msgbox "OK", vbExclamation
End If
End Sub
Private Sub OsenXPButton3_Click()
On Error Resume Next
Grid1.Visible = False
End Sub
Private Sub OsenXPButton4_Click()
On Error Resume Next
Me.Hide
End Sub
Private Sub OsenXPButton5_Click()
On Error Resume Next
PoolConnection
If Text4.Text = "" Then
msgbox "ادخل رقم الحساب المراد حذفه"
Text1.SetFocus
Exit Sub
End If
SQLs = " Select ISPRIMARY From accounts where accid= '" & Text4.Text & "' "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
If rs!ISPRIMARY = 1 Then
msgbox "لايمكن حذف الحساب الرئيسى"
Text4.Text = ""
Exit Sub
End If
SQLs = " Select * From GEED where ACCUMM= '" & Text4.Text & "' "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
If Not rs.EOF Then
msgbox "لايمكن الحذف لوجود قيود متعلقة بالحساب"
Text4.Text = ""
Exit Sub
Else
Dim t, s, r
s = Text4.Text
t = msgbox("هذه العملية ستعمل على حذف الحساب رقم/ " & s & ", " & حساب & ", " & Text2.Text & " ", vbYesNo, "تحذير")
If t = 6 Then
r = InputBox(" ادخل الرقم الخاص باجراءات الحذف")
End If
If r = 123# Then
SQLs = "delete * from Accounts where Accounts.accid= '" & Text4.Text & "' "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
msgbox "تم الحذف "
Text4.Text = ""
End If
End If
Form_LoadFrame2.Visible = False
End Sub
Private Sub OsenXPButton6_Click()
Command5_Click
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If Text1.Text <> "" And KeyAscii = 13 Then
Text2.SetFocus
End If
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Text1.Enabled = True
End Sub
Private Sub Text2_GotFocus()
On Error Resume Next
If op2.Value = True Then
If DB.State = adStateOpen Then DB.Close
DB.Provider = "Microsoft.JET.OLEDB.4.0;"
DB.Open "provider=microsoft.jet.oledb.4.0;data source =" & App.Path + "\data.mdb;Jet OLEDB
atabase Password=111966"If r2.State = adStateOpen Then r2.Close
r2.Open "select max(Accounts.accsort)as sort1 From Accounts ", DB
Text7.Text = 0
Text55.Text = Val(rs2!sort1)
End If
If op1.Value = True Then
If DB.State = adStateOpen Then DB.Close
DB.Provider = "Microsoft.JET.OLEDB.4.0;"
DB.Open "provider=microsoft.jet.oledb.4.0;data source =" & App.Path + "\data.mdb;Jet OLEDB
atabase Password=111966"If r3.State = adStateOpen Then r2.Close
r3.Open "select max(Accounts.accsort)as sort2 From Accounts where accounts.accid= '" & Text3.Text & "' ", DB
'Text7.Text = 0
Text55.Text = Val(rs3!sort2)
r2.Close
r3.Close
End If
'___________________________________________________________________اضافة حساب رئيسى من فرعى_
If op1.Value = True Then
If KeyAscii = 13 Then
If DB.State = adStateOpen Then DB.Close
DB.Provider = "Microsoft.JET.OLEDB.4.0;"
DB.Open "provider=microsoft.jet.oledb.4.0;data source =" & App.Path + "\data.mdb;Jet OLEDB
atabase Password=111966"'End If
If r2.State = adStateOpen Then r2.Close
r2.Open "select * From Accounts WHERE AccID = '" & Text3.Text & "' ", DB
'r2.Open "select * From Accounts WHERE AccID = Trim(Text3.Text)", db1
If Not r2![ARACCDES] = "" Then Combo3 = r2![ARACCDES] 'اسم الحساب
Text5.Text = r2![ACCLEVEL] + 1
If r3.State = adStateOpen Then r3.Close
r3.Open "select * From Accounts WHERE ParAcc = '" & (Text3.Text) & "' order by Accid DESC", DB
rb = r3![accid]
If rb = 0 Then
Text1 = Text3 & 1
Text5.Text = r2![ACCLEVEL] + 1
Text2.SetFocus
Else
Text1 = rb + 3
Text5.Text = r2![ACCLEVEL] + 1
Text2.SetFocus
End If
r2.Close
r3.Close
End If
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
On Error Resume Next
If Text2.Text <> "" And KeyAscii = 13 Then
TEXT22.SetFocus
SQLs = " Select * From accounts where accid= '" & Text3 & "' "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
Text5.Text = rs![ACCLEVEL] + 1
End If
End Sub
Private Sub text22_KeyPress(KeyAscii As Integer)
On Error Resume Next
If TEXT22.Text <> "" And KeyAscii = 13 Then
Combo2.SetFocus
End If
End Sub
Private Sub Combo1_KeyPress(KeyAscii As Integer)
On Error Resume Next
If Combo1.Text <> "" And KeyAscii = 13 Then
command1.SetFocus
End If
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
On Error Resume Next
If Combo2.Text <> "" And KeyAscii = 13 Then
command1.SetFocus
End If
End Sub
Private Sub Text3_Change()
On Error Resume Next
op1.Value = False
op2.Value = False
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 And Text4.Text <> "" Then
OsenXPButton5.SetFocus
End If
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then
command1.SetFocus
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
On Error Resume Next
If op2.Value = True Then
If KeyAscii = 13 Then
SQLs = " Select max(accounts.accsort)as sort2 From accounts where accid = '" & Text3.Text & "' "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
If DB.State = adStateOpen Then DB.Close
DB.Provider = "Microsoft.JET.OLEDB.4.0;"
DB.Open "provider=microsoft.jet.oledb.4.0;data source =" & App.Path + "\data.mdb;Jet OLEDB
atabase Password=111966"'End If
If r2.State = adStateOpen Then r2.Close
r2.Open "select * From Accounts WHERE AccID = '" & Text3.Text & "' ", DB
'r2.Open "select * From Accounts WHERE AccID = Trim(Text3.Text)", db1
If Not r2![ARACCDES] = "" Then Combo3 = r2![ARACCDES] 'اسم الحساب
Text5.Text = r2![ACCLEVEL] + 1
If r3.State = adStateOpen Then r3.Close
r3.Open "select * From Accounts WHERE ParAcc = '" & Text3.Text & "' order by Accid DESC", DB
rb = r3![accid]
If rb = 0 Then
Text1 = Text3 & 0 & 1 & 1
Text5.Text = r2![ACCLEVEL] + 1
Text2.SetFocus
Text55.Text = Val(rs!sort2) + 1
Text7.Text = 0
Else
Text1 = rb + 1
Text5.Text = r2![ACCLEVEL] + 1
Text2.SetFocus
End If
r2.Close
r3.Close
End If
End If
'___________________________________________________________________اضافة حساب رئيسى من فرعى_
If op1.Value = True Then
If KeyAscii = 13 Then
If DB.State = adStateOpen Then DB.Close
DB.Provider = "Microsoft.JET.OLEDB.4.0;"
DB.Open "provider=microsoft.jet.oledb.4.0;data source =" & App.Path + "\data.mdb;Jet OLEDB
atabase Password=111966"'End If
If r2.State = adStateOpen Then r2.Close
r2.Open "select * From Accounts WHERE AccID = '" & Text3.Text & "' ", DB
'r2.Open "select * From Accounts WHERE AccID = Trim(Text3.Text)", db1
If Not r2![ARACCDES] = "" Then Combo3 = r2![ARACCDES] 'اسم الحساب
Text5.Text = r2![ACCLEVEL] + 1
If r3.State = adStateOpen Then r3.Close
r3.Open "select * From Accounts WHERE ParAcc = '" & Text3.Text & "' order by Accid DESC", DB
rb = r3![accid]
If rb = 0 Then
Text1 = Text3 & 0 & 1 & 1
Text5.Text = r2![ACCLEVEL] + 1
Text2.SetFocus
Else
Text1 = rb + 1
Text5.Text = r2![ACCLEVEL] + 1
Text2.SetFocus
End If
r2.Close
r3.Close
End If
End If
End Sub
Private Sub Text3_LostFocus()
On Error Resume Next
Combo2.Text = ""
Text6.Text = Left(Text3.Text, 1)
If Val(Text6.Text) = 5 Or Val(Text6.Text) = 7 Then
Combo2.Text = "حساب النتيجة"
End If
If Val(Text6.Text) = 1 Or Val(Text6.Text) = 3 Then
Combo2.Text = "الميزانية العمومية"
End If
End Sub
Private Sub Text8_Change()
On Error Resume Next
PoolConnection
SQLs = " Select * From Accounts WHERE AccID = '" & Text8.Text & "' "
If rs.State = adStateOpen Then rs.Close
rs.Open SQLs, DB, adOpenKeyset, adLockPessimistic
If Not rs.EOF Then
Text2 = rs![ARACCDES] 'اسم الحساب
Text3 = rs![ParAcc] 'كود حساب اب
Text5 = rs![ACCLEVEL] 'المستوى
Combo1 = rs![s] 'طبيعة الحساب
Combo2 = rs![X] 'نوع الحساب
Text7 = rs![accsort] 'ملاحظات
Text55 = rs![notes] 'ملاحظات
TEXT22 = rs![ISPRIMARY]
End If
End Sub
Private Sub Text8_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 And Text8.Text <> "" Then
OsenXPButton6.SetFocus
End If
End Sub
Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
On Error Resume Next
Text1.Enabled = True
Text4.Text = Val(TreeView1.SelectedItem)
Text8.Text = Val(TreeView1.SelectedItem)
Text3.Text = Val(TreeView1.SelectedItem)
Text3.SetFocus
End Sub
Private Sub TreeView1_DblClick()
On Error Resume Next
Text1.Enabled = True
Text4.Text = Val(TreeView1.SelectedItem)
Text8.Text = Val(TreeView1.SelectedItem)
Text3.Text = Val(TreeView1.SelectedItem)
Text3.SetFocus
End Sub
RE: شجرة الحسابات - السيد الغالي - 14-01-17
بارك الله بك وجعله الله في ميزان حسناتك . جهد رائع يستحق الشكر والتقدير
RE: شجرة الحسابات - khodor1985 - 14-01-17
أخي العزيز، صدقني فكرتك كلها في سي شارب بتنتهي بـ خمسة أسطر.
RE: شجرة الحسابات - awidan76 - 09-05-21
السلام عليكم ورحمة الله وبركاته
اولا اعتذر عن تاخري في المشاركات لهذا المنتدى الرائع لضغوطات عمل
ثانيا تحياتي للأخ sniper. Ps
تحية لاخي الغالي Ahmed_Mansoor
وتحية لأخوي الغالي أمير الزبيدي
واالاخ المحاسب احمد عبدالعليم
وكل أعضاء المنتدى الرائع عامة
واعتذر عن عدم مشاركاتي مؤخرا
وان شاء الله لنا لقائات
بالنسبة للشرح ده فضلا وليس امرا
هل من احد يستطيع تحويله الي مثال بحيث نستفيذ منه كلنا
Ado
ولكم احترامي