تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[vb6.0] شجرة الحسابات
#1
   
نهدى اليكم بمناسبة السنة الميلادية الجديدة فكرة انشاء شجرة الحسابات لمنظومة المحاسبة 
لانشاء دليل حسابات اخترافى لابد من تكوين فكرة مبدئية عن الموضع 
لدينا فى الاساس اربعة حسابات رئيسية 
- حساب الاصول 
- حساب الخصوم
- حساب الايرادات
- حساب المصروفات
وتتفرع هذه الحسابات حسب نشاط كل شركة 

اولا 
عمل جدول فى قاعدة بيانات اكسس 
اسم القاعدة data
اسم الجدول  accounts
اسم الحقل                 نوع الحقل                                       البيـــــــــــــــــــــــــــان
AccID                           نص                                                  رقم الحساب
ArAccDes                      نص                                         وصف الحساب  بالعربية                     
ParAcc                          نص                                              كود الحساب الأب
ArParDes                      نص
IsPrimary                     نص
AccSort                       رقم
S                                 نص

AccLevel                      رقم                                              مستوى الحساب
الرد
#2
الاكواد
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 OLEDBBig Grinatabase 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 OLEDBBig Grinatabase 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 OLEDBBig Grinatabase 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 OLEDBBig Grinatabase 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 OLEDBBig Grinatabase 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 OLEDBBig Grinatabase 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 OLEDBBig Grinatabase 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 OLEDBBig Grinatabase 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 OLEDBBig Grinatabase 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
الرد
#3
بارك الله بك وجعله الله في ميزان حسناتك . جهد رائع يستحق الشكر والتقدير
   تحيــــــــــــــــــــــــــــاتي لكـــــــــــــــــــم    
الرد
تم الشكر بواسطة: Amir_Alzubidy
#4
أخي العزيز، صدقني فكرتك كلها في سي شارب بتنتهي بـ خمسة أسطر.
واعبد ربك حتى يأتيك اليقين
الرد
تم الشكر بواسطة: Amir_Alzubidy
#5
السلام عليكم و رحمة الله و بركاته

ي fayadus اسال الله ان يجعلها في ميزان حسناتك و يجعلها خالصة لوجهه الكريم
لكن اتمنى منك وضع السورس كود لتكتمل الصورة لدى الجميع . و اشكرك من كل قلبي .

ي خضر انا ادرك تماما انها بالسي شارب ستكون اسهل و كانت هي مثالا مصغرا تم استخدامه باحدى محاضراتي ب asp.net. لكنها جديدة لدي بالنسبة لل vb6 .

لا بأس سنستفيد منها و نفيد بها غيرنا ان شاء الله .
وَقُل رَّبِّ اغْفِرْ وَارْحَمْ وَأَنتَ خَيْرُ الرَّاحِمِينَ
الرد


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [vb6.0] شجرة الحسابات fayadus 2 1,461 08-09-17, 08:11 PM
آخر رد: محمود بكرى
  [مشروع] شجرة العائلة مبرمج هاوي 12 6,025 23-05-14, 12:35 AM
آخر رد: rafeekmty

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم