Giúp viết Code nhập dữ liệu từ Form vào Sheets (1 người xem)

Thaiduc · 5/4/12

Anh, chị trong diễn đàn giúp mình viết code để lấy dữ liệu được nhập từ Form (sheet1) và khi click chuột vào nút "NHẬP DỮ LIỆU VÀO BẢNG) thì dữ liệu được ghi vào "KHAI SINH" (sheet2), xóa dữ liệu để nhập mới. Khi dữ liệu mới được nhập thì được ghi vào dòng kế tiếp ở Sheet2. Các nút "về trước", "về sau" để xem lại dữ liệu đã nhập và chỉnh sửa được.

Gửi kèm theo File. Rất mong được giúp. Thân ái !!!

Hai Lúa Miền Tây · 6/4/12

Thaiduc đã viết:
Anh, chị trong diễn đàn giúp mình viết code để lấy dữ liệu được nhập từ Form (sheet1) và khi click chuột vào nút "NHẬP DỮ LIỆU VÀO BẢNG) thì dữ liệu được ghi vào "KHAI SINH" (sheet2), xóa dữ liệu để nhập mới. Khi dữ liệu mới được nhập thì được ghi vào dòng kế tiếp ở Sheet2. Các nút "về trước", "về sau" để xem lại dữ liệu đã nhập và chỉnh sửa được.

Gửi kèm theo File. Rất mong được giúp. Thân ái !!!

Làm cho bạn = ADO theo hình vẽ như bên dưới:

1.) Khai báo và mở kết nối:

Mã:

Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset, r As Integer

Sub Moketnoi()
  With cnn
    .ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0; data source=" & ThisWorkbook.FullName & _
                        ";Extended Properties=Excel 8.0;"
    .CursorLocation = adUseClient
    
    If cnn.State <> 1 Then .Open

    rs.Open "Select * from [KHAI SINH$]", cnn, 1, 3

  End With
    
End Sub

2.) Code nhập liệu:

Mã:

Sub FillList()
If cnn.State <> 1 Then Moketnoi
With rs
    .MoveLast: .MoveFirst: r = .RecordCount
    .AddNew
        ![C1] = Sheet1.Range("D3")
        ![C2] = Sheet1.Range("F3")
        ![C3] = Sheet1.Range("H3")
        ![C4] = Sheet1.Range("D4")
        ![C5] = Sheet1.Range("H4")
        ![C6] = Sheet1.Range("D5")
        ![C7] = Sheet1.Range("D6")
        ![C8] = Sheet1.Range("D7")
        ![C9] = Sheet1.Range("G7")
        ![C10] = Sheet1.Range("D8")
        ![C11] = Sheet1.Range("F8")
        ![C12] = Sheet1.Range("D9")
        ![C13] = Sheet1.Range("D10")
        ![C14] = Sheet1.Range("D11")
        ![C15] = Sheet1.Range("F11")
        ![C16] = Sheet1.Range("H11")
        ![C17] = Sheet1.Range("D9")
        ![C18] = Sheet1.Range("D12")
        ![C19] = Sheet1.Range("D13")
        ![C20] = Sheet1.Range("F13")
        ![C21] = Sheet1.Range("H13")
        ![C22] = Sheet1.Range("D14")
        ![C23] = Sheet1.Range("D15")
        ![C24] = Sheet1.Range("D16")
        ![C25] = Sheet1.Range("D17")
        ![C26] = Sheet1.Range("D18")
        ![C27] = Sheet1.Range("D19")
        ![C28] = r
    .Update
    
MsgBox "Xong"
Sheet1.Range("D3,F3,H3,D4,H4,D5:H5,D6:H6,D7,G7:H7,F8:H8,D8,D9:H9,D10:H10,H11,F11,D11,D12:H12,D13,F13,H13,D14:H19").Select
Selection.ClearContents
Sheet1.Range("A1").Select
End With

End Sub

3.) Code di chuyển về mẫu tin ban đầu:

Mã:

Sub MoveFirst_OnClick()
If cnn.State <> 1 Then Moketnoi
    rs.MoveFirst
    With Sheet1
        Sheet1.Range("D3") = rs("C1")
         .Range("F3") = rs("C2")
         .Range("H3") = rs("C3")
         .Range("D4") = rs("C4")
         .Range("H4") = rs("C5")
         .Range("D5") = rs("C6")
         .Range("D6") = rs("C7")
         .Range("D7") = rs("C8")
         .Range("G7") = rs("C9")
         .Range("D8") = rs("C10")
         .Range("F8") = rs("C11")
         .Range("D9") = rs("C12")
         .Range("D10") = rs("C13")
         .Range("D11") = rs("C14")
         .Range("F11") = rs("C15")
         .Range("H11") = rs("C16")
         .Range("D9") = rs("C17")
         .Range("D12") = rs("C18")
         .Range("D13") = rs("C19")
         .Range("F13") = rs("C20")
         .Range("H13") = rs("C21")
         .Range("D14") = rs("C22")
         .Range("D15") = rs("C23")
         .Range("D16") = rs("C24")
         .Range("D17") = rs("C25")
         .Range("D18") = rs("C26")
         .Range("D19") = rs("C27")
         .Range("E22") = rs("C28")
End With
End Sub

4.) Code di chuyền đến mẫu tin cuối cùng:

Mã:

Sub MoveLast_OnClick()
If cnn.State <> 1 Then Moketnoi
    rs.MoveLast
    With Sheet1
        Sheet1.Range("D3") = rs("C1")
         .Range("F3") = rs("C2")
         .Range("H3") = rs("C3")
         .Range("D4") = rs("C4")
         .Range("H4") = rs("C5")
         .Range("D5") = rs("C6")
         .Range("D6") = rs("C7")
         .Range("D7") = rs("C8")
         .Range("G7") = rs("C9")
         .Range("D8") = rs("C10")
         .Range("F8") = rs("C11")
         .Range("D9") = rs("C12")
         .Range("D10") = rs("C13")
         .Range("D11") = rs("C14")
         .Range("F11") = rs("C15")
         .Range("H11") = rs("C16")
         .Range("D9") = rs("C17")
         .Range("D12") = rs("C18")
         .Range("D13") = rs("C19")
         .Range("F13") = rs("C20")
         .Range("H13") = rs("C21")
         .Range("D14") = rs("C22")
         .Range("D15") = rs("C23")
         .Range("D16") = rs("C24")
         .Range("D17") = rs("C25")
         .Range("D18") = rs("C26")
         .Range("D19") = rs("C27")
         .Range("E22") = rs("C28")
End With
    
End Sub

5.) Code đến mẫu tin tiếp theo

Mã:

Sub MoveNext_OnClick()
On Error Resume Next
If cnn.State <> 1 Then Moketnoi
   If rs.EOF = False Then
     rs.MoveNext
      With Sheet1
         .Range("D3") = rs("C1")
         .Range("F3") = rs("C2")
         .Range("H3") = rs("C3")
         .Range("D4") = rs("C4")
         .Range("H4") = rs("C5")
         .Range("D5") = rs("C6")
         .Range("D6") = rs("C7")
         .Range("D7") = rs("C8")
         .Range("G7") = rs("C9")
         .Range("D8") = rs("C10")
         .Range("F8") = rs("C11")
         .Range("D9") = rs("C12")
         .Range("D10") = rs("C13")
         .Range("D11") = rs("C14")
         .Range("F11") = rs("C15")
         .Range("H11") = rs("C16")
         .Range("D9") = rs("C17")
         .Range("D12") = rs("C18")
         .Range("D13") = rs("C19")
         .Range("F13") = rs("C20")
         .Range("H13") = rs("C21")
         .Range("D14") = rs("C22")
         .Range("D15") = rs("C23")
         .Range("D16") = rs("C24")
         .Range("D17") = rs("C25")
         .Range("D18") = rs("C26")
         .Range("D19") = rs("C27")
         .Range("E22") = rs("C28")
      End With
    End If

End Sub

6.) Code lùi lại mẫu tin trước đó

Mã:

Sub MovePrevious_OnClick()
   On Error Resume Next
   If cnn.State <> 1 Then Moketnoi
   If rs.BOF = False Then
      rs.MovePrevious
      With Sheet1
         .Range("D3") = rs("C1")
         .Range("F3") = rs("C2")
         .Range("H3") = rs("C3")
         .Range("D4") = rs("C4")
         .Range("H4") = rs("C5")
         .Range("D5") = rs("C6")
         .Range("D6") = rs("C7")
         .Range("D7") = rs("C8")
         .Range("G7") = rs("C9")
         .Range("D8") = rs("C10")
         .Range("F8") = rs("C11")
         .Range("D9") = rs("C12")
         .Range("D10") = rs("C13")
         .Range("D11") = rs("C14")
         .Range("F11") = rs("C15")
         .Range("H11") = rs("C16")
         .Range("D9") = rs("C17")
         .Range("D12") = rs("C18")
         .Range("D13") = rs("C19")
         .Range("F13") = rs("C20")
         .Range("H13") = rs("C21")
         .Range("D14") = rs("C22")
         .Range("D15") = rs("C23")
         .Range("D16") = rs("C24")
         .Range("D17") = rs("C25")
         .Range("D18") = rs("C26")
         .Range("D19") = rs("C27")
         .Range("E22") = rs("C28")
   
     End With
   End If

End Sub

7.) Code cập nhật lại dữ liệu (Tôi chỉ làm ví dụ 7 cột tô đỏ, còn lại bạn tự làm)

Mã:

Sub cmdUpdate_Click()
Dim ktr As String
On Error Resume Next
If cnn.State <> 1 Then Moketnoi
    rs.Close
     ktr = MsgBox("Ban co chac cap nhat du lieu ?", vbQuestion + vbYesNo, "Hoi")
        If ktr = vbYes Then
            With rs
                 .Source = "UPDATE [KHAI SINH$] SET C1='" & Sheet1.Range("D3") & "', C2 = '" & Sheet1.Range("F3") & "', C3 = '" & _
                Sheet1.Range("H3") & "', C4 = '" & Sheet1.Range("D4") & "', C5 = '" & Sheet1.Range("H4") & "', C6 = '" & Sheet1.Range("D5") & _
                 "', C7 = '" & Sheet1.Range("D6") & "' WHERE [KHAI SINH$].C28=" & Sheet1.Range("E22")
                 .ActiveConnection = cnn
                 
                 .Open
            End With
       End If
 rs.Close
 cnn.Close

End Sub

8.) Code xóa 1 mẫu tin:

Mã:

Sub cmdDelete_Click()
Dim ktr As String
  ktr = MsgBox("Ban co that su muon xoa ?", vbQuestion + vbYesNo, "Hoi")
     If ktr = vbYes Then
        Dim c As Range
           With Sheet2.Range("AB3:AB" & Sheet2.[a56536].End(xlUp).Row)
              Set c = .Find(Sheet1.Range("E22"), LookIn:=xlValues, LookAt:=xlWhole)
                 If Not c Is Nothing Then
                    c.EntireRow.Delete
                 End If
           End With
    End If
    If cnn.State = 1 Then
        rs.Close
        cnn.Close
        Moketnoi
        MoveNext_OnClick
    End If
End Sub

Bạn xem thêm file nhé.

Giúp viết Code nhập dữ liệu từ Form vào Sheets (1 người xem)

Người dùng đang xem chủ đề này

Thaiduc

Thành viên hoạt động

File đính kèm

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

File đính kèm

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian