Help: Xin File In dữ liệu và đóng khung tự động (1 người xem)

[thanhtung0112]

Hi Anh Chị!
Do công việc của em thường hay trưng cầu ý kiến công nhân viên.
em xin máy huynh hỗ trợ giúp em File tự in dữ liệu và tự đóng khung theo yêu cầu, từ sheet DATA sang sheet DC DMC.
em xin cảm ơn.

 

[leonguyenz]

Hi Anh Chị!
Do công việc của em thường hay trưng cầu ý kiến công nhân viên.
em xin máy huynh hỗ trợ giúp em File tự in dữ liệu và tự đóng khung theo yêu cầu, từ sheet DATA sang sheet DC DMC.
em xin cảm ơn.

Đã có bộ phận ở dòng 10, sao lại thêm cột bộ phận (cột D)?

 

[Nguyễn Hồng Quang]

Bạn xem bài này nhé. Không khác với lần đầu là mấy. Những gì bạn mong muốn đã có ở đây mà

Nhờ hỗ trợ Code in đóng khung tự động

Anh chị ơi! nhờ anh chị hỗ trợ Code giúp em "File đính kèm", in và đóng khung tự động với, em làm thủ bằng tay cực quá.

www.giaiphapexcel.com

 

[thanhtung0112]

Bạn xem bài này nhé. Không khác với lần đầu là mấy. Những gì bạn mong muốn đã có ở đây mà

Nhờ hỗ trợ Code in đóng khung tự động

Anh chị ơi! nhờ anh chị hỗ trợ Code giúp em "File đính kèm", in và đóng khung tự động với, em làm thủ bằng tay cực quá.

www.giaiphapexcel.com

Hàm dư không xóa được.



Thì nó bị dư bảng in, mà nếu xóa hàm thì file dữ liệu chuyển sang sẽ không 9 xác đó bạn ơi hiz

 

[leonguyenz]

Thử code này xem dùng được không:

Sub GpePrint()
Dim dpArr(), sArr(), i As Long, j As Long, k As Long, reArr(), Chk As Variant
sArr = Sheet2.Range("C2:F" & Sheet2.Range("C65535").End(xlUp).Row).Value
dpArr = Sheet2.Range("H2:I" & Sheet2.Range("H65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To 4)
For i = 1 To 3 'UBound(dpArr, 1) '<-- Khi in thi xóa 3, go~ lenh nay
    k = 0
    For j = 1 To UBound(sArr, 1)
        If sArr(j, 4) = dpArr(i, 1) Then
            k = k + 1: reArr(k, 1) = k
            reArr(k, 2) = sArr(j, 1)
            reArr(k, 3) = sArr(j, 2)
            reArr(k, 4) = sArr(j, 3)
        End If
    Next j
    If k Then
        With ActiveSheet
            .Range("D10").Value = dpArr(i, 2)
            .Range("A14:G" & UBound(sArr, 1) + 13).Clear
            .Range("B14").Resize(k).NumberFormat = "@"
            .Range("A14").Resize(k, 4) = reArr
            .Range("A14").Resize(k, 7).Borders.LineStyle = 1
            Chk = MsgBox("Ban co in BP " & dpArr(i, 1) & " khong?", vbYesNo)
            If Chk = vbYes Then
                .PageSetup.PrintTitleRows = "$1:$13"
                On Error Resume Next
                .Names("Print_Area").Delete
                .PageSetup.PrintArea = "$A$1:$G$ " & (k + 13) & """"
                '.PrintOut = True '<-- Khi in thi go~ lenh nay
                MsgBox "Dang in BP" & dpArr(i, 1) '<-- chi de kiem tra
            End If
        End With
    End If
Next i
End Sub