Cùng xây dựng chương trình dự toán trong xây dựng

hoa35ktxd

Thành viên thường trực
Tham gia ngày
8 Tháng hai 2007
Bài viết
298
Thích
266
Điểm
0
Tuổi
45
#1
Chương trình dự toán trong xây dựng hiện nay có rất nhiều phiên bản, nó hỗ trợ rất nhiều cho quá trình lập dự toán của các dự toán viên, tuy nhiên do mỗi người có một cách làm khác nhau, nhu cầu sử dụng cũng khác nhau, người viết đôi khi lại vì thế vẫn còn chỗ nọ chỗ kia nảy sinh thắc mắc.
Tôi lập ra mục này để chúng ta cùng tìm hiểu về cách viết 1 chương trình dự toán, nắm được nó rồi thì tùy từng nhu cầu của mỗi người mà tùy biến cho phù hợp.
Do chương trình rất dài vì vậy không thể đưa lên ngay 1 lúc để soi xét hết được.
Tôi sẽ chuyển toàn bộ mã nguồn từ cái tôi đã viết trước đây bằng VB6 sang VBA để các bạn có nhu cầu cùng tham khảo và nhờ các cao thủ cùng mổ xẻ để tối ưu hơn.
Trước tiên tôi nói về phương pháp làm:
1. Dữ liệu đầu vào bao gồm định mức dự toán, đơn giá dự toán, đơn giá vật tư, bảng lương, các định mức chi phí đầu tư, số liệu về bậc hàng, lọai đường, loại phương tiện.... khá nhiều thứ nhưng trước tiên ta chỉ đề cập đến 2 loại dữ liệu chính đó là "Định mức dự toán" và "Đơn giá dự toán"
- Cơ sở dữ liệu về định mức và đơn giá sẽ lưu trong File access theo quy ước tổ chức như sau: (Để thống nhất)
Định mức: là 1 file.mdb Gồm 3 bảng (table) "DanhMucVatTu", "DinhMucDuToan","PhuLucVua" trong đó:
* Bảng "DanhMucVatTu" có các cột (Field) sau: "MAVT" - Mã vật tư; "TENVT" - Tên vật tư; "DONVI" - Đơn vị tính
* Bảng "DinhMucDuToan" có các cột (Field) sau: "MADM" - Mã định mức; "MAVT" - Mã vật tư; "KLVT" - Khối lượng vật tư
* Bảng "PhuLucVua" có các cột (Field) sau: "MAVUA" - Mã vữa; "MAVT" - Mã vật tư; "KLVT" - Khối lượng vật tư; "TENVUA" - Tên vữa
Đơn giá: Là 1 file.mdb gồm 1 bảng "DonGia" có các cột sau: "MADG" - Mã đơn giá; "TENCV" - Tên công việc; "DONVI" - Đơn vị tính; "DGVL", "DGNC", "DGMAY" - Đơn giá vật liệu, nhân công, máy thi công; "MADM" - Mã dịnh mức; "MAVUA" - Mã vữa.
2. Công cụ thực hiện:
- Sử dụng ADO truy xuất và đặt kết quả lên file excel
- Code chính nằm trong 1 file.xla
3. File kết quả là 1file.xls có kết cấu như file tôi gửi kèm theo sau, trước tiên ta bàn đến việc nhập đơn giá và phân tích vật tư đã nhé.
Nào chúng ta cùng bắt tay, hy vọng mỗi dự toán viến sẽ có 1 chương trình theo đúng ý của mình.
 

File đính kèm

philip

Thành viên chính thức
Tham gia ngày
3 Tháng tám 2007
Bài viết
86
Thích
23
Điểm
0
#3
Việc này rất hay, mỗi dự toán viên nói riêng, hay bất cứ một công việc gì người làm cần nắm rõ bản chất công việc thì rất dể dàng thực hiện.
Tôi ko phải là một dự toán viên nhưng rất ủng hộ bạn họa3ktxd.
Huy vọng trong tương lai gần đây sẽ có được một chương trình dự toán ai cũng có thể dùng một cách dể dàng
 

hoa35ktxd

Thành viên thường trực
Tham gia ngày
8 Tháng hai 2007
Bài viết
298
Thích
266
Điểm
0
Tuổi
45
#4
Cách thức truy xuất và nhập đơn giá

Bây giờ chúng ta cùng bàn về code.
Đầu tiên là việc truy xuất và nhập đơn giá cho bảng dự toán chi tiết.
Ta thường nhập đơn giá theo 2 cách.
1. Nhập trực tiếp mã hiệu đơn giá vào cột mã hiệu nếu ta nhớ chính xác.
2. Tra đơn giá trong danh sách truy vấn từ cơ sở dữ liệu sau đó chèn vào bảng dự toán.
Với cách 1 tôi đã sử dụng ngay các sự kiện của Workbook để thực hiện với code trong file mẫu dữ toán như sau:
PHP:
Dim Ed As Boolean
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 And Target.Value = "" Then
        Cancel = True
        Run "ShowDonGia"
    End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If ActiveSheet.Name = "DTCT" Then
        If Target.Column = 1 And Target.Row > 7 And Not Ed And ActiveCell.Row > Target.Row Then
            Ed = True
            Run "ChenMaDonGia", Target.Value, Target.Row'
        End If
    End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Ed = False
End Sub
Còn đây là 2 sub đầu tiên trong File.xla
PHP:
Public DbConDG As ADODB.Connection
 
Public Sub ChenMaDonGia(MDG As String, Rn As Long)
    Dim Rs As ADODB.Recordset
    If DbConDG Is Nothing Then
        Set DbConDG = CreateObject("ADODB.Connection")
        DbConDG.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\DonGia1728.mdb"
    End If
    Set Rs = CreateObject("ADODB.RecordSet")
    Rs.Open "SELECT MADG, MAVUA, MADM, TENCV, DONVI, '' , DGVL, DGNC, DGMAY FROM [DonGia] Where Ucase(MADG) = '" & UCase(MDG) & "'", DbConDG, adOpenKeyset, adLockPessimistic
    Cells(Rn, 1).CopyFromRecordset Rs
    Rs.Close
    Set Rs = Nothing
End Sub
Public Sub ShowDonGia()
    FormDonGia.Show
End Sub
Hãy đổi tên file FormDonGia.xls gửi kèm theo thành FormDonGia.frm
 

File đính kèm

hoa35ktxd

Thành viên thường trực
Tham gia ngày
8 Tháng hai 2007
Bài viết
298
Thích
266
Điểm
0
Tuổi
45
#5
Phân tích vật tư

Thông thường thì có 2 cách phân tích vật tư.
Cách 1:
Sau khi nhập (hoặc tính diễn giải) khối lượng của một công việc xong thì phân tích vật tư cho công việc đó luôn và chèn vào bên dưới công việc đó trong bảng dự toán chi tiết.
Cách này có vẻ trực quan nhưng không khoa học và tốn nhiều giấy mực vì vậy ta không bàn đến nữa.
Cách 2:
Sau khi nhập xong toàn bộ phần dự toán chi tiết mới tiến hành phân tích vật tư. Cách này lại có 2 cách nhỏ sau:
2.1: Phân tích theo từng công việc: Tức là bên bảng dự toán chi tiết có bao nhiêu mục công việc thì bên bảng phân tích vật tư có bây nhiêu mục.
2.2: Phân tích vật tư theo nhóm công việc: Tức là bên bảng DTCT có những mã nào trùng nhau thì ta nhóm chung vào thành 1 mục rồi phân tích, đây là cách tiết kiệm giấy nhất nhưng phức tạp về code và hơi khó theo dõi, cơ quan thẩm định sẽ hơi đau đầu nếu không có phần mềm để kiểm tra.
Vì vậy ta tập trung vào mỏ xẻ cách 2.1. từ đó ai muốn chuyển sang cách 2.2 cũng không có gì khó.
Sau đây là các đoạn đoạn mã truy vấn phần phân tích vật tư
PHP:
Public Sub PhanTichVT(StrSL As String, Rn As Range)
    Dim RnDT As Long, RnVT As Long'Dòng bắt đầu của mảng dữ liệu trong bảng DTCT và bảng PTVT'
    'StrSL là chuỗi báo hiệu cho ta biết cần phân tích những thành phần nào'
    If StrSL = "" Then Exit Sub'Không có phân thành phần nào được chọn'
    Dim MaDinhMuc As String
    Sheets("DTCT").Select
    RnDT = Rn.Row'Rn là vùng dữ liệu chứa các công việc cần phân tích trong bảng DTCT'
    Dim StrSelect As String
    If InStr(StrSL, "NC") <> 0 And InStr(StrSL, "MAY") <> 0 Then'Có phân tích nhân công và máy thi công'
        StrSelect = " and (DanhMucVatTu.DONVI='Công' or DanhMucVatTu.DONVI='Ca')"
    ElseIf InStr(StrSL, "NC") <> 0 And InStr(StrSL, "MAY") = 0 Then'Chỉ phân tích nhân công
        StrSelect = " and DanhMucVatTu.DONVI = 'Công'"
    ElseIf InStr(StrSL, "NC") = 0 And InStr(StrSL, "MAY") <> 0 Then'Chỉ phân tích máy thi công
        StrSelect = " and DanhMucVatTu.DONVI = 'Ca'"
    End If
    RnVT = 5
    While RnDT <= Rn.Rows.Count + Rn.Row - 1
        If Cells(RnDT, 1).Value = "" Then
            Cells(RnDT, 1).End(xlDown).Select
            RnDT = ActiveCell.Row
        End If
        MaDinhMuc = Cells(RnDT, 3).Value
        If MaDinhMuc <> "" Then
            Dim KhoiLuongCV As String'Địa chỉ chứa khối lượng công việc'
            With Sheets(PTVT)
                .Cells(RnVT, 1).Value = Cells(RnDT, 1).Value
                .Cells(RnVT, 3).Value = Cells(RnDT, 4).Value
                .Cells(RnVT, 4).Value = Cells(RnDT, 5).Value
                .Cells(RnVT, 5).Value = Cells(RnDT, 6).Value
            End With
            KhoiLuongCV = Replace(Cells(RnVT, 5).Address, "$", "")
            If DbConDM Is Nothing Then
                Set DbConDM = CreateObject("ADODB.Connection")
                DbConDM.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\DinhMuc24.mdb"
            End If
            If RsVT Is Nothing Then Set RsVT = CreateObject("ADODB.RecordSet")
            If Cells(RnDT, 2).Value <> "" And FormPhanTichVatTu.ChkVL.Value = True Then'Checkbox trên form, có thể thay thế bằng điều kiện khác'
                'Có sử dụng vữa'
                TruyVanVua MaDinhMuc, Cells(RnDT, 2).Value, KhoiLuongCV
            ElseIf FormPhanTichVatTu.ChkVL.Value = True Then
                'Khong su dung vua va co phan tich vat lieu'
                VatLieuKhac MaDinhMuc, KhoiLuongCV, RnVT
            End If
            'Truy xuat nhan cong, may'
            If FormPhanTichVatTu.ChkNC.Value = True Or FormPhanTichVatTu.ChkMay.Value = True Then
                NhanCongMay MaDinhMuc, KhoiLuongCV, RnVT, StrSelect
            End If
            RnVT = RnVT + 1
        End If
        With FormPhanTichVatTu.Prg'Progressbar theo dõi tiến trình'
            If .Value + 1 <= .Max Then .Value = .Value + 1
        End With
        Cells(RnDT + 1, 1).Select
        If Cells(RnDT + 1, 1).Value = "" Then ActiveCell.End(xlDown).Select
        RnDT = ActiveCell.Row
    Wend
    Set RsVT = Nothing
    Cells(1, 1).Select
End Sub
Private Sub TruyVanVua(Ma_DM As String, Ma_Vua As String, KLCV As String)
    'Cái này có vẻ chưa ổn lắm vì tôi nghĩ sẽ có cách sử dụng câu lệnh SELECT tối ưu hơn'
    Dim RsDMV As ADODB.Recordset
    Set RsDMV = CreateObject("ADODB.RecordSet")
    RsDMV.Open "SELECT DinhMucDuToan.MAVT, DinhMucDuToan.KLVT FROM DinhMucDuToan, DanhMucVatTu Where (DinhMucDuToan.MADM = '" & Ma_DM & _
    "') and DanhMucVatTu.MAVT=DinhMucDuToan.MAVT and instr(DanhMucVatTu.TENVT, 'V" & ChrW(7919) & "a')=1", DbConDM, adOpenKeyset, adLockPessimistic
    If RsDMV.RecordCount = 0 Then Exit Sub
    RsDMV.MoveFirst
    While Not RsDMV.EOF
        RsVT.Open "Select PhuLucVua.MAVT, DanhMucVatTu.TENVT, DanhMucVatTu.DONVI, ''" & _
        ",PhuLucVua.KLVT, '' From PhuLucVua, DanhMucVatTu Where (PhuLucVua.MAVUA = '" & _
        Ma_Vua & "' ) And PhuLucVua.MAVT = DanhMucVatTu.MAVT", DbConDM, adOpenKeyset, adLockPessimistic
        If RsVT.RecordCount > 0 Then
            ChenDuLieu KLCV
            VatLieuKhac Ma_DM, KLCV, RnVT
        End If
        RsDMV.MoveNext
    Wend
    RsDMV.Close
    Set RsDMV = Nothing
End Sub
Private Sub VatLieuKhac(Ma_DM As String, KLCV As String, RnVT As Long)
    RsVT.Open "SELECT DinhMucDuToan.MAVT,DanhMucVatTu.TENVT,DanhMucVatTu.DONVI, '', " & _
    "DinhMucDuToan.KLVT FROM DinhMucDuToan, DanhMucVatTu Where DinhMucDuToan.MADM = '" & Ma_DM & _
    "' and DanhMucVatTu.MAVT=DinhMucDuToan.MAVT  and DanhMucVatTu.DONVI<>'Công' and DanhMucVatTu.DONVI<>'Ca'", DbConDM, adOpenKeyset, adLockPessimistic
    If RsVT.RecordCount = 0 Then RsVT.Close: Exit Sub
    ChenDuLieu KLCV
End Sub
Private Sub NhanCongMay(Ma_DM As String, KLCV As String, RnVT As Long, StrNC_MAY As String)
    RsVT.Open "SELECT DinhMucDuToan.MAVT,DanhMucVatTu.TENVT,DanhMucVatTu.DONVI, '', " & _
    "DinhMucDuToan.KLVT FROM DinhMucDuToan, DanhMucVatTu Where DinhMucDuToan.MADM = '" & Ma_DM & _
    "' and DanhMucVatTu.MAVT=DinhMucDuToan.MAVT " & StrNC_MAY, DbConDM, adOpenKeyset, adLockPessimistic
    If RsVT.RecordCount = 0 Then RsVT.Close: Exit Sub
    ChenDuLieu KLCV
End Sub
Private Sub ChenDuLieu(KLCV As String)
    Dim I As Integer
    I = 1
    Sheets(PTVT).Cells(RnVT + 1, 2).CopyFromRecordset RsVT
    RsVT.MoveFirst
    While Not RsVT.EOF
        Sheets(PTVT).Cells(RnVT + I, 7).Value = "=Round(" & KLCV & "*F" & RnVT + I & ",3)"
        I = I + 1
        RsVT.MoveNext
    Wend
    RnVT = Sheets(PTVT).Cells(65536, 2).End(xlUp).Row
    RsVT.Close
End Sub
Các bạn tham khảo và cho ý kiến, tôi muốn tăng tốc phần này nhưng chưa tìm được biện pháp hữu hiệu hơn.
 
Lần chỉnh sửa cuối:

hoa35ktxd

Thành viên thường trực
Tham gia ngày
8 Tháng hai 2007
Bài viết
298
Thích
266
Điểm
0
Tuổi
45
#6
Tổng hợp vật tư

Hôm nay với sự trợ giúp của diễn đàn, tôi đã hoàn chỉnh bước tổng hợp vật tư với tốc độ tuyệt vời, trước kia còn bập bẹ cứ dùng For Next mà không biết tận dụng các tính năng sẵn có của Excdel.
Sau đây là code tổng hợp vật liệu
PHP:
Public Sub TongHop_VatTu()
    Sheets(PTVT).Select'PTVT là tên của sheet Phân tích vật tư ở bước trước'
    Dim Top As Long, Bot As Long'Dòng trên cùng và dòng dưới của của bảng'
    Dim StrFilter As String'Địa chỉ vùng dữ liệu'
    Top = Range("H1").End(xlDown).Row'Cột H là cột có chứa những ký tự đánh dấu dòng đầu, dòng cuối của bảng'
    Bot = Range("C65536").End(xlUp).Row
    StrFilter = "B" & Top & ":B" & Bot
    Application.ScreenUpdating = False
    Range(StrFilter).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Top = Range("B" & Top).End(xlDown).Row
    Bot = Range("B" & Top).End(xlDown).Row
    StrFilter = "B" & Top & ":D" & Bot
    Range(StrFilter).Copy
    Sheets(THVT).Select'THVT là tên sheet Tổng hợp vật tư'
    Range("B" & Range("J1").End(xlDown).Row + 1).PasteSpecial xlPasteValues
    Range("B" & Range("J1").End(xlDown).Row + 1).Select
    Application.CutCopyMode = 0
    With Sheets(PTVT)
        .ShowAllData
        Top = .Range("H1").End(xlDown).Row + 1
        Bot = .Range("C65536").End(xlUp).Row
    End With
    Dim AddMH As String, AddKL As String'Địa chỉ vùng dữ liệu sử dụng cho hàm Sumif'
    AddMH = "$B$" & Top & ":$B$" & Bot
    AddKL = "$G$" & Top & ":$G$" & Bot
    Top = Range("J1").End(xlDown).Row + 1
    Bot = Range("C65536").End(xlUp).Row
    Range("E" & Top).Value = "=Sumif(" & PTVT & "!" & AddMH & ",B" & Top & "," & PTVT & "!" & AddKL & ")"
    Range("H" & Top).Value = "=G" & Top & "-F" & Top'Chênh lệch giá vật tư'
    Range("I" & Top).Value = "=round(H" & Top & "*E" & Top & ",0)"'Giá trị chênh lệch. Nên sử dụng hàm round để làm tròn luôn, tránh sai số ở các ô tổng cộng'
    Range("E" & Top & ":I" & Bot).FillDown
    Range("E" & Top & ":E" & Bot).Replace "$", ""
    Application.ScreenUpdating = True
End Sub
Vậy là cơ bản đã xong một chương trình dự toán. Phần còn lại là tính toán các chi phí khác, chi phí quản lý đầu tư, chi phí tư vấn đầu tư XD, chi phí dự phòng....
Hy vọng giúp ích ít nhiều cho bạn nào muốn tự xây dựng chương trình dự toán của mình. Ngoài ra còn nhiều tính năng khác cần thiết, các bạn tự bổ sung theo yêu cầu. Có gì sẽ cùng trao đổi thêm.
 

hoa35ktxd

Thành viên thường trực
Tham gia ngày
8 Tháng hai 2007
Bài viết
298
Thích
266
Điểm
0
Tuổi
45
#8
Trời, mình mới được chuyển giới tính lúc nào không biết.
Bảng tính dự toán là bảng nào? Bạn đã hiểu cấu trúc của 1 quyển dự toán chưa?
Ở trên tôi có gửi cái file mẫu rồi đó, trong đó mới chỉ có 2 bảng chính thôi.
Còn nếu làm đồ án thì không nên dùng phần mềm, hãy nghiên cứu kỹ về định mức và đơn giá và phương pháp, trình tự lập dự toán để mà làm, không khó đâu, cơ bản bạn phải nắm và hiểu được nguyên tắc với lại còn phụ thuộc vào việc đồ án bạn đang lập cho công trình thi công ở đâu (Thường thì các thầy giả định là trên địa bàn TP HN để lấy luôn đơn giá của HN cho tiện nhưng tôi không có đơn giá của HN)
 

dphi_long60

Thành viên mới
Tham gia ngày
10 Tháng hai 2007
Bài viết
47
Thích
45
Điểm
0
#9
Chương trình excel này rất hay, mong bạn hoàn chỉnh thành bộ chương trình để anh em có thể ứng dụng thử với dự toán công trình, thành thật cảm ơn trước.
Vì hiện tại chỉ là các bước thử nghiệm chưa thể áp dụng được.
 

hoa35ktxd

Thành viên thường trực
Tham gia ngày
8 Tháng hai 2007
Bài viết
298
Thích
266
Điểm
0
Tuổi
45
#10
Cảm ơn bạn dã quan tâm, nhưng quả thật để viết hoàn chỉnh 1 chương trình thì còn nhiều vấn đề lắm, bây giờ tôi không có nhiều thời gian nên có lẽ không thể làm hoàn chỉnh được, chỉ đưa vấn đề này ra đây để bạn nào chưa biết làm thì có thể tự làm được thôi.
Cho dù tôi có viết hoàn chỉnh thì cũng chỉ phù hợp với tôi và địa phương tôi thôi, khó có thể phù hợp được với tất cả mọi người.
Hiện nay có khá nhiều phần mềm dự toán Free hoặc có thể làm cho nó Free, bạn có thể dễ dàng tìm được.
 
Tham gia ngày
17 Tháng bảy 2009
Bài viết
23
Thích
1
Điểm
365
#11
Nhờ bạn hoa35ktxd giải thích thêm một tí: Sau khi đổi tên FormDonGia.xls thanh FormDonGia.frm và đặt trong cùng 1 thư mục, nhưng khi "DoubleClick" vào ô A8 của sheet DTCT vẫn báo lỗi không hợp lệ.
Rất cám ơn bạn đã gợi ý 1 cách lập dự toán tiện lợi!
 

ldhm

Thành viên mới
Tham gia ngày
9 Tháng mười 2012
Bài viết
19
Thích
0
Điểm
0
Tuổi
38
#16
Mình cũng đang muốn lập một phần mềm dự toán mang tính đặc thù nên rất mong mọi người tham gia và giúp đỡ mình với, mình cảm ơn rất nhiều!
 

ldhm

Thành viên mới
Tham gia ngày
9 Tháng mười 2012
Bài viết
19
Thích
0
Điểm
0
Tuổi
38
#17
Mình bị báo lỗi ở đoạn Code sau:
Private Sub VatLieuKhac(Ma_DM As String, KLCV As String, RnVT As Long)
If DbConDM Is Nothing Then ' Mo ket noi voi file dinh muc 28:
Set DbConDM = CreateObject("ADODB.Connection")
DbConDM.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Dinhmuc28.mdb"
End If ' Mo xong ket noi
RsVT.Open "SELECT DinhMucDuToan.MAVT,DanhMucVatTu.TENVT,DanhMucVatTu.DONVI, '', " & _
"DinhMucDuToan.KLVT FROM DinhMucDuToan, DanhMucVatTu Where DinhMucDuToan.MADM = '" & Ma_DM & _
"' and DanhMucVatTu.MAVT=DinhMucDuToan.MAVT and DanhMucVatTu.DONVI<>'Công' and DanhMucVatTu.DONVI<>'Ca'", DbConDM, adOpenKeyset, adLockPessimistic

If RsVT.RecordCount = 0 Then RsVT.Close: Exit Sub
ChenDuLieu KLCV
End Sub
Rất mong mọi người sửa hộ mình với!
 

duytmd

Thành viên chính thức
Tham gia ngày
28 Tháng bảy 2010
Bài viết
77
Thích
2
Điểm
370
Tuổi
38
#18
Cách thức truy xuất và nhập đơn giá

Bây giờ chúng ta cùng bàn về code.
Đầu tiên là việc truy xuất và nhập đơn giá cho bảng dự toán chi tiết.
Ta thường nhập đơn giá theo 2 cách.
1. Nhập trực tiếp mã hiệu đơn giá vào cột mã hiệu nếu ta nhớ chính xác.
2. Tra đơn giá trong danh sách truy vấn từ cơ sở dữ liệu sau đó chèn vào bảng dự toán.
Với cách 1 tôi đã sử dụng ngay các sự kiện của Workbook để thực hiện với code trong file mẫu dữ toán như sau:
PHP:
Dim Ed As Boolean
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 And Target.Value = "" Then
        Cancel = True
        Run "ShowDonGia"
    End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If ActiveSheet.Name = "DTCT" Then
        If Target.Column = 1 And Target.Row > 7 And Not Ed And ActiveCell.Row > Target.Row Then
            Ed = True
            Run "ChenMaDonGia", Target.Value, Target.Row'
        End If
    End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Ed = False
End Sub
Còn đây là 2 sub đầu tiên trong File.xla
PHP:
Public DbConDG As ADODB.Connection
 
Public Sub ChenMaDonGia(MDG As String, Rn As Long)
    Dim Rs As ADODB.Recordset
    If DbConDG Is Nothing Then
        Set DbConDG = CreateObject("ADODB.Connection")
        DbConDG.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\DonGia1728.mdb"
    End If
    Set Rs = CreateObject("ADODB.RecordSet")
    Rs.Open "SELECT MADG, MAVUA, MADM, TENCV, DONVI, '' , DGVL, DGNC, DGMAY FROM [DonGia] Where Ucase(MADG) = '" & UCase(MDG) & "'", DbConDG, adOpenKeyset, adLockPessimistic
    Cells(Rn, 1).CopyFromRecordset Rs
    Rs.Close
    Set Rs = Nothing
End Sub
Public Sub ShowDonGia()
    FormDonGia.Show
End Sub
Hãy đổi tên file FormDonGia.xls gửi kèm theo thành FormDonGia.frm
Mình click đúp thì báo lỗi run time error 1004
Debug thì báo lỗi ngay dòng Run "ShowDonGia"
 

duytmd

Thành viên chính thức
Tham gia ngày
28 Tháng bảy 2010
Bài viết
77
Thích
2
Điểm
370
Tuổi
38
#19
Mình bị báo lỗi ở đoạn Code sau:
Private Sub VatLieuKhac(Ma_DM As String, KLCV As String, RnVT As Long)
If DbConDM Is Nothing Then ' Mo ket noi voi file dinh muc 28:
Set DbConDM = CreateObject("ADODB.Connection")
DbConDM.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Dinhmuc28.mdb"
End If ' Mo xong ket noi
RsVT.Open "SELECT DinhMucDuToan.MAVT,DanhMucVatTu.TENVT,DanhMucVatTu.DONVI, '', " & _
"DinhMucDuToan.KLVT FROM DinhMucDuToan, DanhMucVatTu Where DinhMucDuToan.MADM = '" & Ma_DM & _
"' and DanhMucVatTu.MAVT=DinhMucDuToan.MAVT and DanhMucVatTu.DONVI<>'Công' and DanhMucVatTu.DONVI<>'Ca'", DbConDM, adOpenKeyset, adLockPessimistic

If RsVT.RecordCount = 0 Then RsVT.Close: Exit Sub
ChenDuLieu KLCV
End Sub
Rất mong mọi người sửa hộ mình với!
Bạn đã chạy được sheet PTVT chưa?
 
Top