Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
PROJECT SOURCE CODE
SPONSORED LINKS
MDI Form
Private Sub MDIForm_Load()
Dim SleepDate As Date
Dim i As Integer
On Error GoTo ErHand
Expiry = True
frmSplash.lbl.Caption = "Loading Please Wait..."
frmSplash.lbl1.Caption = " "
SleepDate = Time
i = 100
For i = 10 To 1 Step -50
Call Sleep(SleepDate + 500 + Val(i))
DoEvents
frmSplash.lbl1.Caption = frmSplash.lbl1.Caption + "|"
Next i
Call Sleep(SleepDate + 1000)
Unload frmSplash
frmLogin.Show vbModal
If Not LoginSucceeded Then End
SelCompFrm.Show vbModal '********* Show The Select Company Form
Exit Sub
ErHand:
MsgBox "Some Internal Error Occurs,Please Contact To Surendra Enterprises..", vbCritical, App.Title
End
End Sub
Private Sub MDIForm_Terminate()
End
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
End
End Sub
Private Sub subMnAccountReports_Click(Index As Integer)
Dim SQL As String
Dim Diff, DrTotal, CrTotal As Double
Select Case Index
Case 0
If DE.OpTrialConn.State = adStateOpen Then DE.OpTrialConn.Close
DE.OpTrialConn.Open ConnectString
SQL = "SELECT ACMAST.ACCODE, ACMAST.ACDESC, AcTrans.CLOSING, AcTrans.YOBDR, AcTrans.YOBCR FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode WHERE ACMAST.RECTYPE ='A' AND NOT(AcTrans.YOBDR=0 AND AcTrans.YOBCR=0) Order By ACMAST.ACDESC"
DE.rsOPTrialCmd.Open SQL, DE.OpTrialConn, adOpenStatic, adLockReadOnly, adCmdText
Set OpTrialRpt.DataSource = DE
OpTrialRpt.Sections("ReportHeader").Controls("DtLbl").Caption = "Opening Trial as on " & Format(SelectedCompany.FromDate, "dd/mm/yyyy")
SQL = "SELECT Sum(AcTrans.CLOSING) AS SumOfCLOSING, Sum(AcTrans.YOBDR) AS SumOfYOBDR, Sum(AcTrans.YOBCR) AS SumOfYOBCR " & _
"FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode WHERE (((ACMAST.RECTYPE)='A'))"
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.Open SQL, DE.OpTrialConn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rst.RecordCount > 0 Then
MsgBox "Account transaction not available.", vbCritical, "Opening Trial"
Exit Sub
End If
DrTotal = IIf(IsNull(rst!SumOfYOBDR), 0, rst!SumOfYOBDR)
CrTotal = IIf(IsNull(rst!SumOfYOBCR), 0, rst!SumOfYOBCR)
Diff = Abs(DrTotal - CrTotal)
OpTrialRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption = Format(IIf(DrTotal < CrTotal, Diff, ""), "0.00")
OpTrialRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption = Format(IIf(CrTotal < DrTotal, Diff, ""), "0.00")
If Val(OpTrialRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption) = Val(OpTrialRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption) Then
OpTrialRpt.Sections("ReportFooter").Controls("DiffLbl").Caption = ""
OpTrialRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption = ""
OpTrialRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption = ""
Else
OpTrialRpt.Sections("ReportFooter").Controls("DiffLbl").Caption = "Difference in Opening :"
End If
OpTrialRpt.Sections("ReportFooter").Controls("DebitLbl").Caption = Format(DrTotal + Val(OpTrialRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption), "0.00")
OpTrialRpt.Sections("ReportFooter").Controls("CreditLbl").Caption = Format(CrTotal + Val(OpTrialRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption), "0.00")
OpTrialRpt.Show
Case 1
TrialBalFrm.Move 0, 0
TrialBalFrm.Show
Case 2
FinLgrFrm.Move 0, 0
FinLgrFrm.Show
Case 3
DayBKFrm.Move 0, 0
DayBKFrm.Show
Case 4
CashBKFrm.Move 0, 0
CashBKFrm.Show
Case 5
BankBKFrm.Move 0, 0
BankBKFrm.Show
Case 6
BSheetFrm.Move 0, 0
BSheetFrm.Show
Case 7
PLFrm.Move 0, 0
PLFrm.Show
End Select
End Sub
Private Sub subMnCompany_Click(Index As Integer)
On Error GoTo ErHand
Dim CompNewFrm As CompFrm
Select Case Index
Case 0 'Select Company
SelCompFrm.Show vbModal
Case 1 'Create
Set CompNewFrm = New CompFrm
CompNewFrm.CompAddMode = True
CompNewFrm.Show
Case 2 'Alter Company
Set CompNewFrm = New CompFrm
CompNewFrm.CompEditMode = True
CompNewFrm.Show
Case 3 'Shut Company
If Forms.Count > 1 Then
MsgBox "Please, Close all open windows then try again.", vbExclamation
Else
Call UnloadApplication(False)
SelectedCompany.Company = ""
Call SetMenuItems
End If
Case 5 'Backup
'BackupFrm.Show vbModal
frmBackRest.Show vbModal
Case 8 'Print Setup
With CD
.DialogTitle = "Print Setup"
If VBA.Environ$("OS") = "Windows_NT" Then
'MsgBox "NT Technology."
Else
.Flags = &H40
End If
.ShowPrinter
End With
Case 10 'Exit
Call UnloadApplication
End Select
ErHand:
If err.Number <> 0 Then
ErrHandler "subMnCompany_Click(" & Index & ")"
End If
End Sub
Private Sub subMnInventoryReports_Click(Index As Integer)
Select Case Index
Case 0 'Sale Register
SaleRegisFrm.Move 0, 0
SaleRegisFrm.Show
Case 1 'Purchase Register
PrchRegisFrm.Move 0, 0
PrchRegisFrm.Show
Case 3 'Stock Register
StockRegisFrm.Move 0, 0
StockRegisFrm.Show
Case 4 'Stock Statement
StatementFrm.Move 0, 0
StatementFrm.Show
Case 5 'Stock Ledger
StockLgrFrm.Move 0, 0
StockLgrFrm.Show
Case 7 'Fastest Selling
MthlyChrtFrm.Show
Case 8 'Manufacturer Wise Sale/Purchase Chart
ManufChrtFrm.Show
Case 9 'Supplier Wise Sale/Purchase Chart
'PartyChrtFrm.Show
End Select
End Sub
Private Sub subMnMiscellaneousReports_Click(Index As Integer)
Select Case Index
Case 0 'Patient History
PatientLedger.Show
Case 1 'Addmission Ledger
Admission_Ragister.Move 0, 0
Admission_Ragister.Show
Case 2 'Doctor/Anesthetist Ledger
'Doctorswork.Show
Doctorledger.Show
Case 3 'Registration Ledger
Registrationfeereport.Show
Case 4 'Supplier Ledger
Case 5 'Head Wise Cash Collection
HeadWiseCashCollection.Show
Case 6 'Date Wise Cash Collection
DateWiseCashCollection.Show
Case 7 'Cosent Form
consent.Show
End Select
End Sub
Private Sub subMnPatientEntries_Click(Index As Integer)
Select Case Index
Case 0 'In Door Patient Registration
registration.Show
Case 1 ' OPD Patient Registration
opd.Move 0, 0
opd.Show
End Select
End Sub
Private Sub subMnTransactionEntries_Click(Index As Integer)
Dim NewFrm As Form
Select Case Index
Case 0 'Purchase
Set NewFrm = New PurchFrm
NewFrm.Tag = "PV"
NewFrm.Show
Case 1 'Purchase Return
Set NewFrm = New PurchFrm
NewFrm.Tag = "PR"
NewFrm.Show
Case 3 'Sale
Set NewFrm = New SaleFrm
NewFrm.Tag = "SV"
NewFrm.Show
Case 4 'Sale Return
Set NewFrm = New SaleFrm
NewFrm.Tag = "SR"
NewFrm.Show
Case 6 'Deep Account View
BEVFrm.Show
End Select
End Sub
Private Sub subMnUtilities_Click(Index As Integer)
Select Case Index
Case 0
Call ShellExecute(Me.hwnd, "Open", "Calc.exe", "", "", ByVal 0)
Case 1
Call ShellExecute(Me.hwnd, "Open", "Notepad.exe", "", "", ByVal 1)
Case 2
Call ShellExecute(Me.hwnd, "Open", "Explorer.exe", "", "", ByVal 1)
Case 3
Call ShellExecute(Me.hwnd, "Open", "Write.exe", "", "", ByVal 1)
Case 5
BalUPDFrm.Show vbModal
Case 6
YrInstFrm.Show vbModal
Case 8
'PwdFrm.Move 0, 0
'PwdFrm.Show
CreateUserFrm.Move 0, 0
CreateUserFrm.Show
End Select
End Sub
Private Sub subMnMasterEntries_Click(Index As Integer)
Select Case Index
Case 0 'Doctor Master Entry
DoctorEntry.Move 0, 0
DoctorEntry.Show
Case 1 'Anaesthetist Master Entry
AnaesthetistEntry.Move 0, 0
AnaesthetistEntry.Show
Case 2 'Department Entry
DepartmentFrm.Move 0, 0
DepartmentFrm.Show
Case 3 ' Bed Master Entry
newbed.Show
Case 5 'Bill Master Entry
BillMaster.Move 0, 0
BillMaster.Show
Case 6 'Daily Fee Master Entry
Dailybill.Move 0, 0
Dailybill.Show
Case 8 ' Diagnosis Entry
Diagnosis.Move 0, 0
Diagnosis.Show
Case 9 ' Complaint Master Entry
complaintmaster.Move 0, 0
complaintmaster.Show
Case 10 'Advice Master Entry
Advice.Move 0, 0
Advice.Show
Case 12 'Account Group Entry
GroupFrm.Move 0, 0
GroupFrm.Show
Case 13 'Create Account Entry
AcountFrm.Show
Case 15 'Item Group Entry
IGFrm.Move 0, 0
IGFrm.Show
Case 16 'Manufacturer Entry
ManufFrm.Move 0, 0
ManufFrm.Show
Case 17 'Item Entry
'ItemFrm.Move 0, 0
ItemFrm.Show
Case 18 'Item Opening Entry
ItemOPFrm.Show
End Select
End Sub
Private Sub subMnVoucherEntries_Click(Index As Integer)
Dim NewFrm As Form
Select Case Index
Case 0 'Payment Voucher
Set NewFrm = New VoucherFrm
NewFrm.Tag = "PT"
NewFrm.Show
Case 1 'Receipt Voucher
Set NewFrm = New VoucherFrm
NewFrm.Tag = "RT"
NewFrm.Show
Case 3 'Contra Voucher
Set NewFrm = New VoucherFrm
NewFrm.Tag = "CO"
NewFrm.Show
Case 4 'Journal Voucher
Set NewFrm = New VoucherFrm
NewFrm.Tag = "JV"
NewFrm.Show
End Select
End Sub
Sponsored Links