Public Function DataGridKnownError(DataError As Integer) As Boolean
Select Case DataError
Case 6153, 7007
'this is a known error but does not affect the result so i disable the messageBox
' MsgBox "DataError : " & DataError & " This Error gives no Harm... but if someone knows how " & vbCr & "to fix this please e-mail to erricoe@TBS.com" & vbCr & " Under Subject: e-mail Razi...He needs my Help", vbCritical, "Known Bugs"
DataGridKnownError = True
Case 7011
'occured when deleting process is cancell
DataGridKnownError = True
Case 6152
'---
DataGridKnownError = False
Case Else
DataGridKnownError = False
End Select
End Function
Public Function UnloadForm(ADOprimaryrs As ADODB.Recordset) As Integer
On Error Resume Next
If CloseAllActive = True Or ADOprimaryrs.RecordCount = 0 Then
ADOprimaryrs.CancelUpdate
ADOprimaryrs.Close
Set ADOprimaryrs = Nothing
UnloadForm = 0
Exit Function
Else
With ADOprimaryrs
If .EditMode <> adEditNone And .EditMode <> adEditAdd Then
Dim CreateOrder As Integer
CreateOrder = MsgBox("Attempting to close the application. " & vbCr & "Would you like to update the data?", vbYesNoCancel, "Exiting")
If CreateOrder = vbYes Then
'If .Status = adRecModified Or .Status = adRecNew Then .Update
.Update
.Close
Set ADOprimaryrs = Nothing
UnloadForm = 0
ElseIf CreateOrder = vbCancel Then
UnloadForm = 1
Else
'If .Status = adRecModified Or .Status = adRecNew Then .CancelUpdate
.CancelUpdate
ADOprimaryrs.Close
Set ADOprimaryrs = Nothing
UnloadForm = 0
End If
Else
.CancelUpdate
ADOprimaryrs.Close
Set ADOprimaryrs = Nothing
UnloadForm = 0
End If
End With
End If
End Function
Public Function CheckDocument(SQLstatement As String, db As ADODB.Connection, Optional ShowMessage As Boolean, Optional txtCallType As TextBox, Optional lblCallType As String) As Boolean
MsgBox "New data have been transferred to SHIP TO SETUP, but you have to add more data and save it.", vbInformation, "Information"
End Select
txtCallType.Text = " "
Else
txtCallType.Text = " "
End If
End If
FalseFlag:
Set cbRS = Nothing
'dbCnn.Close
'Set dbCnn = Nothing
ShowStatus False
End Function
'for each control whose input you wish to validate, just put something like this
'in the KeyPress event of the control-->>keyResponse=CtrlValidate(Keyascii, "$.0123456789")
'Doing so will filter out any undesired keys that go to the control, accepting
'only the keys defined by the second parameter. In this case, that parameter
'("$.0123456789") defines characters that are valid for a currency but put this after the code
' If keyResponse = False Then
' KeyAscii = 0
' End If
Public Function CtrlValidate(KeyIn As Integer, ValidateString As String) As Boolean
Dim ValidateList As String
Dim KeyOut As Integer
If KeyIn = 8 Or KeyIn = 9 Then
CtrlValidate = True
Exit Function
End If
If InStr(1, ValidateString, Chr(KeyIn), 1) > 0 Then
CtrlValidate = True
Else
CtrlValidate = False
Beep
End If
End Function
Public Function CheckCombo(SourceCombo As ComboBox, Optional FieldName As String, Optional TableName As String, Optional db As ADODB.Connection, Optional MsgLoad As Boolean) As Boolean
On Error GoTo exit_function
Dim i As Integer
Dim Response As Integer
CheckCombo = True
For i = 0 To SourceCombo.ListCount - 1
If SourceCombo.Text = SourceCombo.List(i) Then
CheckCombo = False
End If
Next
If CheckCombo = True And MsgLoad = True And SourceCombo.Text <> "" Then
Dim ADOnewRS As ADODB.Recordset
Response = MsgBox("This is a new input for " & fMainForm.ActiveForm.lblfields(SourceCombo.Index) & " , would you like to add it to the database?", vbYesNo, "Information")
MsgBox "New data have been transferred to TAX GROUP, but you have to add more data and save it." & vbCr & "Then the data will be available to use after you click the refresh button", vbInformation, "Information"
MsgBox "New data have been transferred to PAY TERMS, but you have to add more data and save it." & vbCr & "Then the data will be available to use after you click the refresh button", vbInformation, "Information"
' MsgBox "New data have been transferred to PAY TERMS, but you have to add more data and save it." & vbCr & "Then the data will be available to use after you click the refresh button", vbInformation, "Information"
' rsBank![BANK ACCT Next Check No] = Str(Val(CheckNumber) + 1)
'End If
Case "BACK"
rsBank![BANK ACCT Next Check No] = Str(Val(CheckNumber) - 1)
End Select
rsBank.Update
rsBank.Close
Set rsBank = Nothing
'013-3514255
Exit Function
NoCheck:
CheckNumberCHQ = ""
ShowStatus False
End Function
Public Function CheckCheckNumber(Account As String, CheckNumber As String, db As ADODB.Connection, Optional MustTrue As Boolean) As String
CheckAgain:
If CheckDocument("SELECT [AP PAY Check No] FROM [AP Payment Header] WHERE [AP PAY Bank Account]='" & Account & "' AND [AP PAY Check No]='" & CheckNumber & "'", db, True) = True Then
'cek masih tidak digunakan
If MustTrue = True Then
CheckCheckNumber = "Not Found"
Exit Function
Else
CheckCheckNumber = Str(CheckNumber)
End If
Else
'cek sudah digunakan
If MustTrue = True Then
CheckCheckNumber = "Found"
Exit Function
Else
CheckNumber = Str(Val(CheckNumber) + 1)
GoTo CheckAgain
End If
End If
End Function
Public Function CheckCreditLimit(CurrentRequest As Currency, txtFieldsCust As String, db As ADODB.Connection, Optional ShowCredit As Boolean) As Boolean
GotCountFlag = MsgBox("Work is in Progress, Please Wait a Few second." & vbCr & "Stopping the process will cause an internal (Razi is still working on this)", vbYesNo, "Information")
If GotCountFlag = vbYes Then
DynaGL.Close
GoTo FindAgain
Else
GoTo Skip_PostGLWorkDetail
End If
Else
DynaGL.MoveFirst
''On Error GoTo PostGLWork_Error
NewGLNumber& = GLNumber&
Do While DynaGL.EOF = False
If DynaGL("SumOfGW TRANSD Debit Amount") = DynaGL("SumOfGW TRANSD Credit Amount") Then
' They negate each other so don't write them
Else
If DynaGL("SumOfGW TRANSD Debit Amount") > 0 And DynaGL("SumOfGW TRANSD Credit Amount") > 0 Then
rsGLTrans.Open "SELECT [GL Trans Number],[GL Trans Amount] FROM [GL Transaction] WHERE [GL Trans Number]=" & NewGLNumber& & "", db, adOpenKeyset, adLockOptimistic, adCmdText
'MsgBox rsGLTrans.RecordCount
'rsGLTrans.MoveLast
If GlDebitTotal@ = GLCreditTotal@ Then
rsGLTrans("GL Trans Amount") = GlDebitTotal@
Else
rsGLTrans("GL Trans Amount") = 0
End If
rsGLTrans.Update
rsGLTrans.Close
Set rsGLTrans = Nothing
'GoTo again
PostGLWorkDetail = True
DynaGL.Close
Set DynaGL = Nothing
If Currentdb = True Then
db.Close
Set db = Nothing
End If
Exit Function
Skip_PostGLWorkDetail:
DynaGL.Close
Set DynaGL = Nothing
If Currentdb = True Then
db.Close
Set db = Nothing
End If
' End of post GL Work to GL Trans
PostGLWorkDetail = False
Exit Function
PostGLWork_Error:
MsgBox "Error"
DynaGL.Close
PostGLWorkDetail = False
Set DynaGL = Nothing
If Currentdb = True Then
db.Close
Set db = Nothing
End If
Exit Function
End Function
Function PostCOA(Account$, TranDate As Variant, DebitAmount@, CreditAmount@, Optional db As ADODB.Connection) As Integer
