กระทู้เก่าบอร์ด อ.Yeadram
1,051 3
URL.หัวข้อ /
URL
โค้ด macro Error

ตามรูปเลยครับผมแก้ไม่เป็นขอความกรุณาด้วยครับ
3 Reply in this Topic. Dispaly 1 pages and you are on page number 1
1 @R21474

2 @R21475
Option Compare Database
Dim adoCon As New ADODB.Connection
Dim adoRs As New ADODB.Recordset
Private Sub cmdAdd_Click()
ClearTexBox
adoRs.AddNew
adoRs.MoveLast
End Sub
Private Sub cmdDEL_Click()
On Error GoTo ErrHandler
With adoRs
If .RecordCount > 0 Then
.Delete
.MoveNext
If Not (.EOF) Then
DisplayRecord
ElseIf .EOF And .RecordCount > 0 Then
.MovePrevious
DisplayRecord
ElseIf .EOF And .RecordCount <= 0 Then
ClearTextBox
End If
End If
End With
Exit Sub
ErrHandler:
If Err.Number <> 0 Then MsgBox "Error:" & Err.Number & Chr(13) & Chr(13) & Err.Description, , "Error"
End Sub
Private Sub CmdMoveFirst_Click()
On Error Resume Next
adoRs.MoveFirst
DisplayRecord
End Sub
Private Sub cmdMoveLast_Click()
On Error Resume Next
adoRs.MoveLast
DisplayRecord
End Sub
Private Sub cmdMoveNext_Click()
On Error Resume Next
adoRs.MoveNext
If adoRs.EOF Then adoRs.MovePrevious
DisplayRecord
End Sub
Private Sub cmdMovePrevios_Click()
On Error Resume Next
adoRs.MovePrevious
If adoRs.BOF Then adoRs.MoveNext
DisplayRecord
End Sub
Private Sub cmdUpdate_Click()
On Error GoTo ErrHandler
adoRs![Model_ID] = txtModel
adoRs![PCB] = txtPCB
adoRs![thickness] = txtthickness
adoRs![Model_Name] = txtModelName
adoRs.Update
Exit Sub
ErrHandlar
If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & Chr(13) & Chr(13) & Err.Description, , "Error"
End Sub
Private Sub ClearTextBox()
txtModel = ""
txtPCB = ""
txtthickness = ""
txtModelName = ""
End Sub
Private Sub Form_Load()
Set adoCon = CurrentProject.Connection
adoRs.Open "SELECT * FROM Products", adoCon, adOpenStatic, adLockOptimistic
If adoRs.RecordCount > 0 Then DisplayRecord
End Sub
Private Sub From_Unload(Cancel As Integer)
adoRs.Close
Set adoRs = Nothing
adoCon.Close
Set adoCon = Nothing
End Sub
โค้ดที่เขียนครับ
Dim adoCon As New ADODB.Connection
Dim adoRs As New ADODB.Recordset
Private Sub cmdAdd_Click()
ClearTexBox
adoRs.AddNew
adoRs.MoveLast
End Sub
Private Sub cmdDEL_Click()
On Error GoTo ErrHandler
With adoRs
If .RecordCount > 0 Then
.Delete
.MoveNext
If Not (.EOF) Then
DisplayRecord
ElseIf .EOF And .RecordCount > 0 Then
.MovePrevious
DisplayRecord
ElseIf .EOF And .RecordCount <= 0 Then
ClearTextBox
End If
End If
End With
Exit Sub
ErrHandler:
If Err.Number <> 0 Then MsgBox "Error:" & Err.Number & Chr(13) & Chr(13) & Err.Description, , "Error"
End Sub
Private Sub CmdMoveFirst_Click()
On Error Resume Next
adoRs.MoveFirst
DisplayRecord
End Sub
Private Sub cmdMoveLast_Click()
On Error Resume Next
adoRs.MoveLast
DisplayRecord
End Sub
Private Sub cmdMoveNext_Click()
On Error Resume Next
adoRs.MoveNext
If adoRs.EOF Then adoRs.MovePrevious
DisplayRecord
End Sub
Private Sub cmdMovePrevios_Click()
On Error Resume Next
adoRs.MovePrevious
If adoRs.BOF Then adoRs.MoveNext
DisplayRecord
End Sub
Private Sub cmdUpdate_Click()
On Error GoTo ErrHandler
adoRs![Model_ID] = txtModel
adoRs![PCB] = txtPCB
adoRs![thickness] = txtthickness
adoRs![Model_Name] = txtModelName
adoRs.Update
Exit Sub
ErrHandlar
If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & Chr(13) & Chr(13) & Err.Description, , "Error"
End Sub
Private Sub ClearTextBox()
txtModel = ""
txtPCB = ""
txtthickness = ""
txtModelName = ""
End Sub
Private Sub Form_Load()
Set adoCon = CurrentProject.Connection
adoRs.Open "SELECT * FROM Products", adoCon, adOpenStatic, adLockOptimistic
If adoRs.RecordCount > 0 Then DisplayRecord
End Sub
Private Sub From_Unload(Cancel As Integer)
adoRs.Close
Set adoRs = Nothing
adoCon.Close
Set adoCon = Nothing
End Sub
โค้ดที่เขียนครับ
3 @R21477
ลอง Compile ดูก่อนนะครับ เชื่อว่าโค้ดน่าจะเขียนผิด Syntax ตรงไหนสักแห่ง
Time: 0.3785s