Giúp update modules VBA (1 người xem)

tueyennhi · 18/2/17

Chào anh chị!

Em đang có một vấn đề đau đầu như sau:

Khi xây dựng Modules tính công, theo thời gian em thấy được nhiều điểm cần phải chỉnh sửa. Tuy nhiên mỗi lần chỉnh sửa như thế em lại phải hỗ trợ bộ phận update các Modules mới. Như vậy thật phức tạp và không khoa học cho lắm. Giả sử em có 10 cái modules thì em phải gỡ ra toàn bộ sau đó insert 10 modules chỉnh sửa vào.

Vậy có cách nào mà biến tất cả các modules này thành một file để ở ổ nào đó mà sau này mỗi lần thay đổi bộ phận chỉ cần tải file mới này vào và lưu vào địa chỉ file cũ không ạ?

tueyennhi · 20/2/17

befaint đã viết:
Bạn tham khảo file đính kèm nhé...

Hura, thành công rồi. Cảm ơn befaint!

PHP:

Sub SubMain()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wb As Workbook, pth As String
Dim i As Integer, Ipath As String, iName()
Set wb = ThisWorkbook
Ipath = GetFolder("") 'Goi ham chon thu muc
If Ipath = "" Then Exit Sub
iName = GetFileList(Ipath) 'Goi ham lay ten cac file trong thu muc vua chon
For i = 1 To UBound(iName)
    pth = Ipath & "\" & iName(i) 'Ghep lai thi duoc duong dan day du cua file (fullpath)
wb.VBProject.VBComponents.Import (pth)
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

tueyennhi · 23/2/17

Không ổn rồi befaint, làm trên office 2007 và 2013 thì xảy ra lỗi cụ thể như sau:

PHP:

Sub Update_Delete()
Dim wb As Workbook, pth As String
Dim i As Integer, Ipath As String, iName()
Dim x As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
    On Error Resume Next
    With ActiveWorkbook.VBProject
        For x = .VBComponents.Count To 1 Step -1
            .VBComponents.Remove .VBComponents(x)
        Next x
    End With
Set wb = ThisWorkbook
Ipath = GetFolder("") 'Goi ham chon thu muc
If Ipath = "" Then Exit Sub
iName = GetFileList(Ipath) 'Goi ham lay ten cac file trong thu muc vua chon
For i = 1 To UBound(iName)
    pth = Ipath & "\" & iName(i) 'Ghep lai thi duoc duong dan day du cua file (fullpath)
wb.VBProject.VBComponents.Import (pth)
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Bấm Debug thì thấy bôi vàng ở dòng Next x

befaint · 23/2/17

@tueyennhi,

Không rõ ý tưởng bạn làm như nào?

Nếu sub Update_Delete để ở trong acitveworkbook, khi bạn xóa các module thì chừa sub đó ra chứ...

tueyennhi · 23/2/17

befaint đã viết:
@tueyennhi,

Không rõ ý tưởng bạn làm như nào?

Nếu sub Update_Delete để ở trong acitveworkbook, khi bạn xóa các module thì chừa sub đó ra chứ...

Bạn xem file đính kèm giúp mình, khi bấm update nó có bị đơ không nhé. Không hiểu sao của mình thì không vấn đề gì (phiên bản Office 2010) nhưng sang máy Office phiên bản 2007 thì dính lỗi như bài trên mình đã nói. Đơ hết luôn. Code mình để trong This book. Ý tưởng của mình là xóa tất cả những gì có trong module, còn các sub trong sheet, hay trong this book thì không ảnh hường. Quá trình xóa xong hiện cửa sổ chọn thư mục update module mới vào. Tuy nhiên lỗi xảy ra như bên trên mình đã miêu tả.

tueyennhi · 23/2/17

befaint ơi ổn rồi, phải tích trong trust center (macro) mới chạy được

befaint · 23/2/17

tueyennhi đã viết:
befaint ơi ổn rồi, phải tích trong trust center (macro) mới chạy được

Vậy là bạn hổng có đọc link tôi gửi ở bài #5...

(1) Tham khảo bài viết theo link sau:
http://www.cpearson.com/excel/vbe.aspx

Next, you need to enable programmatic access to the VBA Project. In Excel 2003 and earlier, go the Tools menu (in Excel, not in the VBA editor), choose Macros and then the Security item. In that dialog, click on the Trusted Publishers tab and check the Trust access to the Visual Basic Project setting.

In Excel 2007, click the Developer item on the main Ribbon and then click the Macro Security item in the Code panel. In that dialog, choose Macro Settings and check the Trust access to the VBA project object model.

tueyennhi · 23/2/17

befaint đã viết:
Vậy là bạn hổng có đọc link tôi gửi ở bài #5...

Trước khi bài đó bạn đăng thì mình tìm được code xóa module trên diễn đàn rồi, và áp dụng luôn thấy chạy được nên không đọc kỹ bài của bạn chứ mình cũng có vào link đó xem có học thêm được gì không.

tueyennhi · 23/2/17

À befaint xem giúp mình trường code này có vấn đề mà mình chưa biết cách sửa:

PHP:

'Tong Thòi Gian Làm Viec:
 Arr() = [F9].Resize(Rws, 8).Value
 ReDim dArr(1 To Rws, 1 To 3)
    For J = 1 To UBound(Arr())
    dArr(J, 1) = 0
    dArr(J, 2) = 0
        Sht = Arr(J, 1)
    If Arr(J, 6) <> "" And Arr(J, 7) <> "" And Arr(J, 8) <> "" Then
                dArr(J, 1) = Arr(J, 6)
                dArr(J, 2) = Arr(J, 7)
    Else
        If Abs(Arr(J, 4) - Arr(J, 3)) >= T8 Then
            Select Case Sht
            Case "H"
                If Arr(J, 3) <= T8 Then
                    If Arr(J, 4) >= T17 Then
                        dArr(J, 1) = GQC(Sht, True)
                            dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            Case "N"
                If Arr(J, 3) <= T8 Then
                    If Arr(J, 4) >= T20 Then
                        dArr(J, 1) = GQC(Sht, True)
                        dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            Case "D"
                If Arr(J, 3) <= T20 Then
                    If Arr(J, 4) >= T8 Then
                        dArr(J, 1) = GQC(Sht, True)
                        dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            Case "X"
                If Arr(J, 3) <= T6 Then
                    If Arr(J, 4) >= T14 Then
                        dArr(J, 1) = GQC(Sht, True)
                        dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            Case "Y"
                If Arr(J, 3) <= T14 Then
                    If Arr(J, 4) >= T22 Then
                        dArr(J, 1) = GQC(Sht, True)
                        dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            Case "Z"
                If Arr(J, 3) <= T22 Then
                    If Arr(J, 4) >= T6 Then
                        dArr(J, 1) = GQC(Sht, True)
                        dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            End Select
        End If
    End If
        dArr(J, 3) = (dArr(J, 2) - dArr(J, 1)) * 24
        dArr(J, 3) = Round(dArr(J, 3), 2)
 Next J
 [O9].Resize(Rws, 3).Value = dArr()

Đối với trường hợp ca Z:
- Nếu giờ vào của mình so với T22 (tức 22h) mà nhỏ hơn hoặc bằng thì lấy giờ vào là 22.
- Nếu giờ ra của mình so với T6 (tức 6h sáng) mà lớn hơn hoặc bằng thì lấy giờ ra là 6h.
--> giờ vào 22h, ra 6h
Tuy nhiên với giờ ra mà lớn hơn 11h (ví dụ họ ra là 12h). thì giờ vào và ra đều là 00:00--->không có công

tueyennhi · 23/2/17

tueyennhi đã viết:

À befaint xem giúp mình trường code này có vấn đề mà mình chưa biết cách sửa:

PHP:

'Tong Thòi Gian Làm Viec:
 Arr() = [F9].Resize(Rws, 8).Value
 ReDim dArr(1 To Rws, 1 To 3)
    For J = 1 To UBound(Arr())
    dArr(J, 1) = 0
    dArr(J, 2) = 0
        Sht = Arr(J, 1)
    If Arr(J, 6) <> "" And Arr(J, 7) <> "" And Arr(J, 8) <> "" Then
                dArr(J, 1) = Arr(J, 6)
                dArr(J, 2) = Arr(J, 7)
    Else
        If Abs(Arr(J, 4) - Arr(J, 3)) >= T8 Then
            Select Case Sht
            Case "H"
                If Arr(J, 3) <= T8 Then
                    If Arr(J, 4) >= T17 Then
                        dArr(J, 1) = GQC(Sht, True)
                            dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            Case "N"
                If Arr(J, 3) <= T8 Then
                    If Arr(J, 4) >= T20 Then
                        dArr(J, 1) = GQC(Sht, True)
                        dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            Case "D"
                If Arr(J, 3) <= T20 Then
                    If Arr(J, 4) >= T8 Then
                        dArr(J, 1) = GQC(Sht, True)
                        dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            Case "X"
                If Arr(J, 3) <= T6 Then
                    If Arr(J, 4) >= T14 Then
                        dArr(J, 1) = GQC(Sht, True)
                        dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            Case "Y"
                If Arr(J, 3) <= T14 Then
                    If Arr(J, 4) >= T22 Then
                        dArr(J, 1) = GQC(Sht, True)
                        dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            Case "Z"
                If Arr(J, 3) <= T22 Then
                    If Arr(J, 4) >= T6 Then
                        dArr(J, 1) = GQC(Sht, True)
                        dArr(J, 2) = GQC(Sht, False)
                    End If
                End If
            End Select
        End If
    End If
        dArr(J, 3) = (dArr(J, 2) - dArr(J, 1)) * 24
        dArr(J, 3) = Round(dArr(J, 3), 2)
 Next J
 [O9].Resize(Rws, 3).Value = dArr()

Đối với trường hợp ca Z:
- Nếu giờ vào của mình so với T22 (tức 22h) mà nhỏ hơn hoặc bằng thì lấy giờ vào là 22.
- Nếu giờ ra của mình so với T6 (tức 6h sáng) mà lớn hơn hoặc bằng thì lấy giờ ra là 6h.
--> giờ vào 22h, ra 6h
Tuy nhiên với giờ ra mà lớn hơn 11h (ví dụ họ ra là 12h). thì giờ vào và ra đều là 00:00--->không có công

À mình ra vấn đề rồi, lý do là do code này:
If Abs(Arr(J, 4) - Arr(J, 3)) >= T8 Then

Giúp update modules VBA (1 người xem)

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

tueyennhi

Thành viên tích cực

tueyennhi

Thành viên tích cực

tueyennhi

Thành viên tích cực

befaint

|||||||||||||

tueyennhi

Thành viên tích cực

File đính kèm

tueyennhi

Thành viên tích cực

befaint

|||||||||||||

tueyennhi

Thành viên tích cực

tueyennhi

Thành viên tích cực

tueyennhi

Thành viên tích cực

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