如何实现定向自动打印

q305256130

如题，见附件。

清风竹-

请看附件。

3190496160

Sub 打印()
Dim ar As Variant, br As Variant
Dim arr(), brr()
ar = Sheets("客户拉货明细").[a1].CurrentRegion
br = Sheets("客户归属").[a1].CurrentRegion
With Sheets("打印")
    xm = .[d1]
    ReDim arr(1 To UBound(br), 1 To 1)
    For i = 2 To UBound(br)
        If Trim(br(i, 1)) = Trim(xm) Then
            n = n + 1
            arr(n, 1) = br(i, 2)
        End If
    Next i
    If n = "" Then End
    For s = 1 To n
        m = 0
        ReDim brr(1 To UBound(ar), 1 To UBound(ar, 2))
        For i = 2 To UBound(ar)
            If Trim(ar(i, 1)) = Trim(arr(s, 1)) Then
                m = m + 1
                For j = 1 To UBound(ar, 2)
                    brr(m, j) = ar(i, j)
                Next j
            End If
        Next i
        If m > 0 Then
           r = .Cells(Rows.Count, 1).End(xlUp).Row
            .Range("a3:e" & r + 1).Borders.LineStyle = 0
            .Range("a3:e" & r + 1) = Empty
            .[a3].Resize(m, UBound(brr, 2)) = brr
            .Cells(m + 3, 1) = "合计"
            .Cells(m + 3, 3) = Application.Sum(Application.Index(brr, 0, 3))
            .Cells(m + 3, 5) = Application.Sum(Application.Index(brr, 0, 5))
            .[a3].Resize(m + 1, UBound(brr, 2)).Borders.LineStyle = 1
            .PrintOut
        End If
    Next s
End With
MsgBox "ok!"
End Sub

3190496160

Book3.rar (21.43 KB, 下载次数: 5)

2022-9-5 20:52 上传

点击文件名下载附件

q305256130

清风竹- 发表于 2022-9-5 18:42
请看附件。

感谢！

q305256130

3190496160 发表于 2022-9-5 20:51
Sub 打印()
Dim ar As Variant, br As Variant
Dim arr(), brr()

感谢！