如何实现自动复制读取数据并打印

透明世界1987

实现自动打印.zip (481.83 KB, 下载次数: 8)

2023-2-22 13:46 上传

点击文件名下载附件

skiss

参与一下

1. Sub dytest()
   
2. 
   
3. gs = [L2]
   
4. 
   
5. cs = [M2]
   
6. 
   
7. For i = gs To cs
   
8. 
   
9.     ActiveSheet.Cells(2, 2) = Sheets("采购销售合同").Cells(i + 1, "k")
   
10. 
    
11.     ActiveSheet.PrintOut Copies:=1
    
12. 
    
13. Next
    
14. 
    
15. End Sub

复制代码

gwjkkkkk

Sub test()
    Dim ar, br, cr, i&, j&, r&, iStart&, iEnd&, vKey, iPosCol&
   
    Set dic = CreateObject("Scripting.Dictionary")
    iStart = [L2]: iEnd = [M2]
    br = Range("j2", Cells(Rows.Count, "K").End(3))
    If iStart < 1 Or iEnd > UBound(br) Then MsgBox "取值范围有误，请检查！": Exit Sub
   
    With Sheets(1)
        cr = Range(.[A7], .Cells(Rows.Count, "AD").End(3))
    End With
   
    For k = iStart To iEnd
        With Range("A12", Cells(Rows.Count, "I").End(3))
            .Offset(1).ClearContents
            ar = .Resize(UBound(cr))
            For i = 1 To UBound(ar, 2): dic(ar(1, i)) = i: Next
            r = 1
        End With
        vKey = br(k, 2)
        For i = 2 To UBound(cr)
            If cr(i, UBound(cr, 2)) = vKey Then
                r = r + 1
                For j = 1 To UBound(cr, 2)
                    If dic.exists(cr(1, j)) Then
                        iPosCol = dic(cr(1, j))
                        ar(r, iPosCol) = cr(i, j)
                    End If
                Next j
            End If
        Next i
        [A12].Resize(r, UBound(ar, 2)) = ar
        ActiveSheet.PrintOut
    Next k
End Sub

gwjkkkkk

代码重写了一遍，请楼主参考。。。

透明世界1987

gwjkkkkk 发表于 2023-2-22 20:16
代码重写了一遍，请楼主参考。。。

感谢大侠，有个问题每个都需要手动保存，需要实现自动将文件命名为B2发票号A1采购销售合同，例如1234567采购销售合同，然后自动保存在某个文件夹

透明世界1987

skiss 发表于 2023-2-22 16:40
参与一下

感谢大神，基本是可以 就是保存和文件命名能否自动，文件自动保存在桌面或者某个文件夹，命名为发票号+采购销售合同 也就是b2+a1