ghi dữ liệu từ form của file đang mở vào file đang đóng nằm cung thư mục (2 người xem)

[quoc nhat]

chào các anh chị
nhờ các anh chị viết giúp em code ghi dữ liệu từ form trên file A vào file B khi file B đang đóng với ạ, ghi theo dòng các anh chị ạ
link file:
http://www.mediafire.com/download/ckvv850uka7aghl/New+Folder.rar

cảm ơn các anh chị nhiều lắm!

 

[HyperLink]

theo mình,
- bạn cần tạo thêm 1 Form lấy thông tin từ file B (ID, mã bảo hiểm ...) đưa vào 1 Listbox
- form này có chức năng tìm kiếm, tạo 1 sự kiện double click trên Listbox để show Form QLKB 2.0.1.
=======
đó là ý tưởng để hỗ trợ sửa thông tin hàng loạt, còn nếu bạn chủ yếu sửa từng ID thôi thì ko cần form đó, nhưng hiện tại file A, B ko có số liệu gì cả nên ko đoán được bạn sẽ thao tác ntn ...

 

[giaiphap]

chào các anh chị
nhờ các anh chị viết giúp em code ghi dữ liệu từ form trên file A vào file B khi file B đang đóng với ạ, ghi theo dòng các anh chị ạ
link file:
http://www.mediafire.com/download/ckvv850uka7aghl/New+Folder.rar

cảm ơn các anh chị nhiều lắm!

File của bạn nhập báo bỗi ngày thàng hoài, làm biếng sửa lại quá, bạn xem đoạn code sau đây để tham khảo

[COLOR=#404040][FONT=Consolas]Sub OpenAndManipulate()[/FONT][/COLOR]    Dim xl0 As New Excel.Application
    Dim xlw As New Excel.Workbook
    Set xlw = xl0.Workbooks.Open("c:\somefile.xls")
    xl0.Worksheets.Add
    xl0.ActiveSheet.Cells(1, 1) = "Hello"
    xl0.ActiveSheet.Cells(1, 2) = "World"
    xlw.Save
    xlw.Close
    Set xl0 = Nothing
    Set xlw = Nothing 
[COLOR=#404040][FONT=Consolas]End Sub[/FONT][/COLOR]

 

[quoc nhat]

theo mình,
- bạn cần tạo thêm 1 Form lấy thông tin từ file B (ID, mã bảo hiểm ...) đưa vào 1 Listbox
- form này có chức năng tìm kiếm, tạo 1 sự kiện double click trên Listbox để show Form QLKB 2.0.1.
=======
đó là ý tưởng để hỗ trợ sửa thông tin hàng loạt, còn nếu bạn chủ yếu sửa từng ID thôi thì ko cần form đó, nhưng hiện tại file A, B ko có số liệu gì cả nên ko đoán được bạn sẽ thao tác ntn ...

mình sử dụng File B đề chứa thông tin về Thẻ BHYT sau đó ở File A mình dùng hàm VLOOKUP tìm kiếm thông tin thẻ đã nhập vào file B để sử dụng lâu dài, mình muốn tách ra 2 file riêng biệt để cho nhẹ chương trình mình đang làm ấy mà

 

[quoc nhat]

file của bạn nhập báo bỗi ngày thàng hoài, làm biếng sửa lại quá, bạn xem đoạn code sau đây để tham khảo

[color=#404040][font=consolas]sub openandmanipulate()[/font][/color]    dim xl0 as new excel.application
    dim xlw as new excel.workbook
    set xlw = xl0.workbooks.open("c:\somefile.xls")
    xl0.worksheets.add
    xl0.activesheet.cells(1, 1) = "hello"
    xl0.activesheet.cells(1, 2) = "world"
    xlw.save
    xlw.close
    set xl0 = nothing
    set xlw = nothing 
[color=#404040][font=consolas]end sub[/font][/color]

nó chỉ ghi được vào hàng trên cùng chứ không ghi liên tiếp được hả bạn

 

[quoc nhat]

Giúp em với các anh chị ơi!

 

[ec ec]

Giúp em với các anh chị ơi!

ui, may quá

Private Sub CommandButton5_Click()Dim con As New ADODB.Connection, rs As New ADODB.Recordset, ctrl As Control
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & ThisWorkbook.Path & "B.xls;extended properties=excel 8.0"
With rs
    .Open "Select * From [Sheet1$]", con, , 3
    If TextBox2 <> "" And TextBox6 <> "" And CtDate1 <> "" And Ctdate2 <> "" _
    And ComboBox1 <> "" And ComboBox2 <> "" And ComboBox3 <> "" Then
            .AddNew
            .Fields(0) = TextBox1
            .Fields(1) = TextBox2
            .Fields(2) = Ctdate2
            .Fields(3) = ComboBox1
            .Fields(4) = CtDate
            .Fields(5) = CtDate1
            .Fields(6) = ComboBox3
            .Fields(7) = ""
            .Fields(8) = TextBox6
            .Fields(9) = TextBox8
            .Fields(10) = ComboBox2
            .Update
            MsgBox "Da nhap"
            On Error Resume Next
            For Each ctrl In Controls
                ctrl.Value = ""
            Next
    Else: MsgBox "Coi lai cac o danh dau (*)"
    End If
End With
rs.Close: Set rs = Nothing
con.Close: Set con = Nothing
End Sub

 

[quoc nhat]

ui, may quá

Private Sub CommandButton5_Click()Dim con As New ADODB.Connection, rs As New ADODB.Recordset, ctrl As Control
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & ThisWorkbook.Path & "B.xls;extended properties=excel 8.0"
With rs
    .Open "Select * From [Sheet1$]", con, , 3
    If TextBox2 <> "" And TextBox6 <> "" And CtDate1 <> "" And Ctdate2 <> "" _
    And ComboBox1 <> "" And ComboBox2 <> "" And ComboBox3 <> "" Then
            .AddNew
            .Fields(0) = TextBox1
            .Fields(1) = TextBox2
            .Fields(2) = Ctdate2
            .Fields(3) = ComboBox1
            .Fields(4) = CtDate
            .Fields(5) = CtDate1
            .Fields(6) = ComboBox3
            .Fields(7) = ""
            .Fields(8) = TextBox6
            .Fields(9) = TextBox8
            .Fields(10) = ComboBox2
            .Update
            MsgBox "Da nhap"
            On Error Resume Next
            For Each ctrl In Controls
                ctrl.Value = ""
            Next
    Else: MsgBox "Coi lai cac o danh dau (*)"
    End If
End With
rs.Close: Set rs = Nothing
con.Close: Set con = Nothing
End Sub

nó bị lỗi ở chổ này bạn ơi, không hiểu sao nữa "

Private Sub CommandButton5_Click()
[COLOR=#ff0000]Dim con As New ADODB.Connection[/COLOR], rs As New ADODB.Recordset, ctrl As Control
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & ThisWorkbook.Path & "B.xls;extended properties=excel 8.0"
With rs
    .Open "Select * From [Sheet1$]", con, , 3
    If TextBox2 <> "" And TextBox6 <> "" And CtDate1 <> "" And Ctdate2 <> "" _
    And ComboBox1 <> "" And ComboBox2 <> "" And ComboBox3 <> "" Then
            .AddNew
            .Fields(0) = TextBox1
            .Fields(1) = TextBox2
            .Fields(2) = Ctdate2
            .Fields(3) = ComboBox1
            .Fields(4) = CtDate
            .Fields(5) = CtDate1
            .Fields(6) = ComboBox3
            .Fields(7) = ""
            .Fields(8) = TextBox6
            .Fields(9) = TextBox8
            .Fields(10) = ComboBox2
            .Update
            MsgBox "Da nhap"
            On Error Resume Next
            For Each ctrl In Controls
                ctrl.Value = ""
            Next
    Else: MsgBox "Coi lai cac o danh dau (*)"
    End If
End With
rs.Close: Set rs = Nothing
con.Close: Set con = Nothing
End Sub

 

[ec ec]

nó bị lỗi ở chổ này bạn ơi, không hiểu sao nữa

Dim con As New ADODB.Connection
Trong cửa sổ VBE bạn vô menu Tools - References...,check Microsoft ActiveX Data Objects 2.1 Library

 

[quoc nhat]

nó bị lỗi ở chổ này bạn ơi, không hiểu sao nữa

Dim con As New ADODB.Connection
Trong cửa sổ VBE bạn vô menu Tools - References...,check Microsoft ActiveX Data Objects 2.1 Library

MÌNH LÀM ĐƯỢC RỒI NHƯNG LẠI KHÔNG GHI ĐƯỢC VÀO FILE B BẠN Ạ

 

[quoc nhat]

xem lại giúp mình với ec ec ơi

 

[ec ec]

MÌNH LÀM ĐƯỢC RỒI NHƯNG LẠI KHÔNG GHI ĐƯỢC VÀO FILE B BẠN Ạ

máy sao lại chập chờn vậy
bạn kiểm tra lại :
-tên file B là B.xls
-Sheet ghi dữ liệu của file B là Sheet1 (nếu đổi tên sheet là ... tiêu)
-file A và B phải trong cùng môt folder
nếu đã thỏa mãn các điều kiện trên mà không được thì bạn up file báo lỗi lên

 

[quoc nhat]

máy sao lại chập chờn vậy
bạn kiểm tra lại :
-tên file B là B.xls
-Sheet ghi dữ liệu của file B là Sheet1 (nếu đổi tên sheet là ... tiêu)
-file A và B phải trong cùng môt folder
nếu đã thỏa mãn các điều kiện trên mà không được thì bạn up file báo lỗi lên

nó bil lỗi ở đoạn này

 .Open "Select * From [Sheet1$]", con, , 3

link file đây bạn
http://www.mediafire.com/download/ckvv850uka7aghl/New+Folder.rar
xem lại giùm mình với nhé

 

[ec ec]

nó bil lỗi ở đoạn này

 .Open "Select * From [Sheet1$]", con, , 3

link file đây bạn
http://www.mediafire.com/download/ckvv850uka7aghl/New+Folder.rar
xem lại giùm mình với nhé

tôi không thây lỗi gì cả, bạn lỗi như bạn mô tả chỉ xảy ra khi file B không cùng folder với A hoặc file B không có Sheet1

 

[quoc nhat]

tôi không thây lỗi gì cả, bạn lỗi như bạn mô tả chỉ xảy ra khi file B không cùng folder với A hoặc file B không có Sheet1

File A và File B cùng thư mục như em gửi lên mà (chưa nén)
Em cũng không hiểu bị làm sao nữa

 

[quoc nhat]

nó lỗi như trong hình này bạn ec ec à
http://www.mediafire.com/view/62t2q89bs1ua4o1/untitled.bmp

 

[ec ec]

File A và File B cùng thư mục như em gửi lên mà (chưa nén)
Em cũng không hiểu bị làm sao nữa

Tôi nhận ra rồi, bạn sửa lại dòng lệnh sau :
"Data Source=" & ThisWorkbook.Path & "\B.xls;extended properties=excel 8.0"
thêm dấu \ trước chữ B.xls

 

[quoc nhat]

Bạn chép 2 file A và B vào ổ D:, mỏ file A lên chạy thử coi

Đã làm, vẫn bị lỗi y chang như vậy. hay máy tính của mình có cài thiếu gì không nhỉ

 

[quoc nhat]

Bạn ơi nếu để nó nằm ngoài ổ D thì ghi được không lỗi gì cả nếu để trong cùng thư mục thì bị lỗi là sao

 

[ec ec]

Bạn ơi nếu để nó nằm ngoài ổ D thì ghi được không lỗi gì cả nếu để trong cùng thư mục thì bị lỗi là sao

bạn thêm dấu \ như đã nói lại trong bài #17 .