VBA+SQL批量打印直拨单程序如何控制分页？

autumnalRain

一、求助主题：想利用VBA+SQL批量打印直拨单。请各位老师依据本人思路进行指点，对本人是个学习过程。感谢……
二、本人思路：
1、生成打印清单，如【打印清单】工作表
2、以查询清单的凭证号和项目名称作为查询条件生成单个凭证号下的不同项目的领料记录，如【查询结果】工作表
3、判断领料记录是否超过10行--不超过10行，自动编号，空行不编号；超过10行刚清空以前内容，重新打印一张，并自动编号，空行不编号；见【材料直拨单模板】
三、求助内容：
第三步，如何根据查询记录行数判断是否分页，并写入数据至【材料直拨单模板】


代码如下：
Dim I As Integer
Sub 查询结果()
Dim Rmax As Integer
Dim SVoucher, SProject
Rmax = Sheets("打印清单").Range("a1").CurrentRegion.Rows.Count ' MsgBox Rmax
   
For I = 2 To Rmax
    SVoucher = Sheets("打印清单").Cells(I, 1)
    SProject = Sheets("打印清单").Cells(I, 2)
    Sheets("查询结果").Cells.Clear
    Dim cnn As Object, SQL
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "provider=microsoft.ACE.OLEDB.12.0;extended properties='Excel 12.0;hdr=yes';data source=" & ThisWorkbook.FullName
    SQL = "select 凭证号,名称,规格,单位,数量,单价,金额,项目名称 from [项目名称$] where [凭证号]=""" & SVoucher & """ And [项目名称]= """ & SProject & """"
    Sheets("查询结果").[a1].CopyFromRecordset cnn.Execute(SQL)
     
With Sheets("材料直拨单模板") '直拨单数据写入
MsgBox I
Union(.[B2], .[C2], .[G2]).ClearContents
.[B2] = SProject
.[C2] = Right(SVoucher, Len(SVoucher) - InStrRev(SVoucher, "-"))
.[G2] = Left(SVoucher, InStrRev(SVoucher, "-")) & "28"
End With
    cnn.Close
    Set cnn = Nothing
      
   Next I
     
End Sub

opiona

提供一个思路：

1. 
   
2. <P>Set SH0 = Sheets("打印数据")
   
3. Set SH1 = Sheets("打印模板")</P>
   
4. <P>'//清空模板数据
   
5. For IROW = 2 To SH0.Range("A65536").End(3).Row Step 10  '//10行一页
   
6.     SH1.Cells(2, 2) = SH0.Cells(IROW, 2) '//模板数据在固定位置的！
   
7.     For I = 1 To 10  '//一页10行
   
8.         If Len(SH0.Cells(IROW + I - 1, 1)) > 0 Then '//是否空行
   
9.             SH1.Cells(I, 1) = I  '//编号
   
10.             SH1.Cells(I, 2) = SH0.Cells(IROW + I - 1, 1)
    
11.         Else
    
12.             Exit For
    
13.         End If
    
14.     Next</P>
    
15. <P>'//打印出来
    
16. Next IROW</P>

复制代码

autumnalRain

opiona 发表于 2015-7-28 07:53
提供一个思路：

老师，您能否把你的这部分代码加入到我未写完的部分?参与到FOR循环中？就是每查询一次打印一次。感谢

autumnalRain

opiona 发表于 2015-7-28 07:53
提供一个思路：

本人水平有限，只能做到这个部分，保证查询结果都是正确的。但是变化的查询结果根据其实行数判断并写入到材料直拨单模板，，如何控制分页打印确实无法解决，请帮助！
Sub 查询结果()
    Dim I As Integer
    Dim K As Integer
    Dim Rmax As Integer
    Dim SVoucher, SProject
    Dim strSQL As String
    Dim strconn As String
    Dim ADOConn As Object
   ' Dim ADORst As adodb.Recordset   ‘这句的adodb.Recordset  换成 Object执行没有问题，否则执行出现“用户定义对象未定义” 搞不清为什么 ？
Set ADOConn = CreateObject("ADODB.Connection")
    strconn = "provider=microsoft.ACE.OLEDB.12.0;extended properties='Excel 12.0;hdr=yes';data source=" & ThisWorkbook.FullName
         
    Rmax = Sheets("打印清单").Range("a1").CurrentRegion.Rows.Count
   
    For I = 2 To Rmax
        SVoucher = Sheets("打印清单").Cells(I, 1)
        SProject = Sheets("打印清单").Cells(I, 2)
        Sheets("查询结果").Cells.Clear
        
        strSQL = "select 凭证号,名称,规格,单位,数量,单价,金额,项目名称 from [项目名称$] where [凭证号]=""" & SVoucher & """ And [项目名称]= """ & SProject & """"
        ADOConn.Open strconn
        Set ADORst = ADOConn.Execute(strSQL)
        For K = 0 To ADORst.Fields.Count - 1
        Sheets("查询结果").Cells(1, K + 1) = ADORst.Fields(K).Name
        Next K
        
        Sheets("查询结果").[A2].CopyFromRecordset ADORst
   
'            With Sheets("材料直拨单模板") '直拨单数据写入
'               Union(.[B2], .[C2], .[G2]).ClearContents
'                .[B2] = SProject
'                .[C2] = Right(SVoucher, Len(SVoucher) - InStrRev(SVoucher, "-"))
'                .[G2] = Left(SVoucher, InStrRev(SVoucher, "-")) & "28"
'             End With
        ADORst.Close
        ADOConn.Close
       ' Set ADOconn = Nothing 意义何在？
    Next I
     
End Sub

autumnalRain

CopyFromRecordset方法的使用说明


作者：bengdeng | 来源：Excel吧 | 时间：2008-10-13 | 阅读权限：游客 | 会员币：0 | 【大 中 小】






介绍CopyFromRecordset方法的目的，是因为在以后的 SQL语言教程 中，我们大部份都需要它，来完成数据库向Excel传递内容的任务，因此特别在这里列出来说明一下。下面的大部份内容，可以在Excel的VBA帮助中找到。

CopyFromRecordset 方法的功能是将一个 ADO 或 DAO Recordset 对象的内容复制到工作表中，复制的起始位置在指定区域的左上角。其语法为：

expression.CopyFromRecordset(Data, MaxRows, MaxColumns)

expression  ：   必需。该表达式返回一个 Range 对象。

Data  ：   Variant 类型，必需。复制到指定区域的 Recordset 对象。

MaxRows   ：   Variant 类型，可选。复制到工作表的记录个数上限。如果省略该参数，将复制 Recordset 对象的所有记录。

MaxColumns  ：    Variant 类型，可选。复制到工作表的字段个数上限。如果省略该参数，将复制 Recordset 对象的所有字段。

说明：复制从 Recordset 对象的当前行开始的内容。复制完成之后，Recordset 对象的 EOF 属性值为 True。

autumnalRain

1. 
   
2. Sub 查询结果()
   
3.     Dim I As Integer
   
4.     Dim K As Integer
   
5.     Dim Rmax As Integer
   
6.     Dim SVoucher, SProject
   
7.     Dim SQL As String
   
8.     Dim conn As String
   
9.     Dim ADOConn As Object
   
10.     Dim ADORst As Object
    
11.    
    
12.     Set ADOConn = CreateObject("ADODB.Connection")
    
13.     Set ADORst = CreateObject("ADODB.Recordset")
    
14.     conn = "provider=microsoft.ACE.OLEDB.12.0;extended properties='Excel 12.0;hdr=yes';data source=" & ThisWorkbook.FullName
    
15.          
    
16.     Rmax = Sheets("打印清单").Range("a1").CurrentRegion.Rows.Count
    
17.    
    
18.     For I = 2 To Rmax
    
19.         SVoucher = Sheets("打印清单").Cells(I, 1)
    
20.         SProject = Sheets("打印清单").Cells(I, 2)
    
21.         Sheets("查询结果").Cells.Clear
    
22.         
    
23.         SQL = "select 凭证号,名称,规格,单位,数量,单价,金额,项目名称 from [项目名称$] where [凭证号]=""" & SVoucher & """ And [项目名称]= """ & SProject & """"
    
24.         ADOConn.Open conn
    
25.         ADORst.Open SQL, ADOConn, 3, 3
    
26.         
    
27.         Debug.Print ADORst.RecordCount '得到记录集的行数
    
28.         For K = 0 To ADORst.Fields.Count - 1
    
29.         Sheets("查询结果").Cells(1, K + 1) = ADORst.Fields(K).Name
    
30.         Next K
    
31.         
    
32.         Sheets("查询结果").[A2].CopyFromRecordset ADORst
    
33.    
    
34. '            With Sheets("材料直拨单模板") '直拨单数据写入
    
35. '               Union(.[B2], .[C2], .[G2]).ClearContents
    
36. '                .[B2] = SProject
    
37. '                .[C2] = Right(SVoucher, Len(SVoucher) - InStrRev(SVoucher, "-"))
    
38. '                .[G2] = Left(SVoucher, InStrRev(SVoucher, "-")) & "28"
    
39. '             End With
    
40.         ADORst.Close
    
41.         ADOConn.Close
    
42.        'Set ADORst = Nothing
    
43.        'Set ADOConn = Nothing
    
44.     Next I
    
45.      
    
46. End Sub
    
47. 
    

复制代码

autumnalRain

在朱荣兴老师的指导下，得以解决！感谢！

1. Sub 批量打印()
   
2. Set ADOConn = CreateObject("ADODB.Connection")
   
3. Set ADORst = CreateObject("ADODB.Recordset")
   
4. conn = "provider=microsoft.ACE.OLEDB.12.0;extended properties='Excel 12.0;hdr=yes';data source=" & ThisWorkbook.FullName
   
5. Rmax = Sheets("查询清单").Range("a1").CurrentRegion.Rows.Count
   
6. For i = 2 To Rmax
   
7.     SVoucher = Sheets("查询清单").Cells(i, 1)
   
8.     SProject = Sheets("查询清单").Cells(i, 2)
   
9.     Sheets("查询结果").Cells.Clear
   
10.     SQL = "select 名称,规格,单位,数量,单价,金额 from [项目名称$] where [凭证号]=""" & SVoucher & """ And [项目名称]= """ & SProject & """" '注意在VBA中SQL使用where多条件查询时的表达方法
    
11.     ADOConn.Open conn
    
12.     ADORst.Open SQL, ADOConn, 3, 3
    
13.     Debug.Print ADORst.RecordCount
    
14.     For k = 0 To ADORst.Fields.Count - 1
    
15.         Sheets("查询结果").Cells(1, k + 1) = ADORst.Fields(k).name
    
16.     Next k
    
17.     Sheets("查询结果").[a2].CopyFromRecordset ADORst
    
18. 
    
19.     With Sheets("打印模板")
    
20.     Union(.[B2], .[C2], .[G2]).ClearContents
    
21.     .[B2] = SProject
    
22.     .[e2] = Right(SVoucher, Len(SVoucher) - InStrRev(SVoucher, "-"))
    
23.     .[G2] = Left(SVoucher, InStrRev(SVoucher, "-")) & "28"
    
24. '      For X = 2 To Sheets("查询结果").Cells(Rows.Count, 1).End(xlUp).Row Step 10
    
25.       For X = 2 To ADORst.RecordCount + 1 Step 10
    
26.        Sheets("打印模板").Range("b4:g13").ClearContents
    
27.        Sheets("查询结果").Range("A" & X & ":F" & X + 9).Copy
    
28.        Sheets("打印模板").Cells(4, 2).PasteSpecial Paste:=xlPasteValues
    
29.        ActiveSheet.PrintOut From:=1, To:=1, Copies:=1
    
30.       Next
    
31.      End With
    
32.     ADORst.Close
    
33.     ADOConn.Close
    
34. Next i
    
35. Set ADORst = Nothing
    
36. Set ADOConn = Nothing
    
37. End Sub

复制代码

补充内容 (2016-2-15 19:50):
本方法可以简化，[查询结果$]表可以省略，如何取依次取每个10条记录，见9楼赵老师的代码

autumnalRain

特别感谢朱荣兴老师！一直以来都犯了个低级错误。原来我的理解一直都是错误的：象本例循环几次，打印几次，每次循环打印的内容也发生了变化。我却理解成只打印了最后一次。恍然大悟！

autumnalRain

学习贴：要求将查询结果按照每35行分一次列，写到[个人捐款汇总$]中，查询条件为活动工作表的科目[F1]日期介于[B2]和[D2]间
赵刚老师的代码解决了一直以来的疑惑，在此转到本贴，当做学习笔记！
应该重点学习的内容是依次取得第一个35条记录，第二个35条记录……第N个35条记录，如何写代码见代码第8-11行

1. Sub ADO法()
   
2.     Dim cnn As Object, rs As Object, SQL$, i&
   
3.     Set cnn = CreateObject("ADODB.Connection")
   
4.     cnn.Open "Provider = Microsoft.Jet.Oledb.4.0;Extended Properties ='Excel 8.0;hdr=no';Data Source =" & ThisWorkbook.FullName
   
5.     SQL = "Select f1,f3,f6,f7 from [收支记录$a4:g]  where f2='" & [f1] & "' and f1 between #" & [b2] & "# and #" & [d2] & "#"
   
6.     Set rs = cnn.Execute(SQL)
   
7.     [a1].CurrentRegion.Offset(3).ClearContents
   
8.     While Not rs.EOF
   
9.          Cells(4, i + 1).CopyFromRecordset rs, 35
   
10.          i = i + 4
    
11.     Wend
    
12.     rs.Close
    
13.     cnn.Close
    
14.     Set rs = Nothing
    
15.     Set cnn = Nothing
    
16. End Sub

复制代码

autumnalRain

特别需要强调的一句话：
使用CopyFromRecordset方法时，复制从 Recordset 对象的当前行开始的内容。复制完成之后，Recordset 对象的 EOF 属性值为 True。