求助excel调用word连续打印

wjd74

在excel中调用word连续打印，word文当中含有不规则表格和规则表格，请问如何快速的将不规则表格和规则表格的内容删除，并且每次调用打印word文当时都可见，

liyh67

没看明白，上传附件好吗？

wjd74

在excel中执行vba程序打开word文档并执行有选择性的打印

守柔

第一个问题，可以如：

Sub Example() Dim aTable As Table Application.ScreenUpdating = False For Each aTable In ActiveDocument.Tables'遍历活动文档表格 aTable.Range.Delete'清空单元格内容(非删除单元格) Next Application.ScreenUpdating = True End Sub

第二个问题,只要在调用WORD.APPLICATION时,使WORD.APPLICATION.VISIBLE=TRUE 就可以了.

如果搞不定,可以上传附件,我们一起来完成.

wjd74

清除表格内容和打印都很慢，请教有没有更快的办法 Private Sub CB_PRINT_Click() Dim A As Byte Dim B As Byte Dim i As Integer Dim J As Integer Dim iData() As Variant Dim iBinno As Variant Dim MyData As Boolean Dim iStore As Integer Dim iBinno1 As String Dim MyWord As New Word.Application Dim MyDoc As New Word.Document Application.ScreenUpdating = False If cb_mode.Value > 2 Then ReDim iData(ListBox1.ListCount, 3) As Variant J = 0 With ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) = True Then J = J + 1 iData(J, 1) = CStr(.List(i, 1)) iData(J, 2) = Val(.List(i, 7)) iData(J, 3) = Val(.List(i, 9)) End If Next End With Else ReDim iData(1, 3) As Variant J = CB_RR.ListIndex iData(1, 1) = CB_RR.List(J, 0) iData(1, 2) = Val(CB_RR.List(J, 1)) iData(1, 3) = Val(CB_RR.List(J, 2)) J = 1 End If Form_Print.Hide If J > 0 Then MyWord.Documents.Open "d:\cost\收货单.doc", Passworddocument:="COST" Set MyDoc = MyWord.Documents("收货单") Cnn.Open Driver_Cost For B = 1 To J If MsgBox("确定打印" & iData(B, 1) & "收货单请按“yes”", vbYesNo) = vbYes Then With MyDoc.Tables(1) .Cell(3, 2).Range.Delete .Cell(3, 4).Range.Delete .Cell(3, 6).Range.Delete .Cell(2, 5).Range.Delete .Cell(16, 6).Range.Delete For i = 6 To 15 For A = 1 To 6 .Cell(i, A).Range.Delete Next Next End With ForA = 1 To 2 CC.Cmd_Val = Array(Array(4, IIf(A = 1, "find_rr_base", "find_rr"), 2,1), _ Array("irrno", 200, 10, iData(B, 1)), _ Array("iFrom", 16, 0, 2)) ‘自定义类模块，用于取得记录集 With Rs If .EOF = False Then If A = 1 Then ‘单据的表头 With MyDoc.Tables(1) .Cell(3, 2).Range.InsertAfter Rs!RR_PRNO .Cell(3, 4).Range.InsertAfter Rs!SUP_NAME .Cell(3, 6).Range.InsertAfter Rs!DE_NAME .Cell(2, 5).Range.InsertAfter Rs!RR_Date .Cell(16, 6).Range.InsertAfter Format(Rs!AMOUNT, "#0.00") End With Else i = 6 单据的内容 Do While .EOF = False With MyDoc.Tables(1) .Cell(i, 1).Range.InsertAfter Rs!RR_BINNO .Cell(i, 2).Range.InsertAfter Rs!ST_NAME & IIf(Len(Rs!ST_SIZE) >0, "/" & Rs!ST_SIZE, "") & IIf(Len(Rs!ST_MAKE) > 0, "/"& Rs!ST_MAKE, "") .Cell(i, 3).Range.InsertAfter Rs!ST_UNIT .Cell(i, 4).Range.InsertAfter Format(Rs!RR_QTY, "#0.00") .Cell(i, 5).Range.InsertAfter Format(Rs!RR_COST, "#0.000") .Cell(i, 6).Range.InsertAfter Format(Rs!AMOUNT, "#0.00") End With i = i + 1 .MoveNext Loop MyDoc.PrintOut Range:=wdPrintCurrentPage End If Else A = 3 End If .Close End With Next End If Next Set Rs = Nothing Cnn.Close Set Cnn = Nothing MyDoc.Close SaveChanges:=wdDoNotSaveChanges MyWord.Quit Set MyDoc = Nothing Set MyWord = Nothing ThisWorkbook.Activate End If End Sub

wjd74

刚发的程序比较难看，重发 Private Sub CB_PRINT_Click() Dim A As Byte Dim B As Byte Dim i As Integer Dim J As Integer Dim iData() As Variant Dim iBinno As Variant Dim MyData As Boolean Dim iStore As Integer Dim iBinno1 As String Dim MyWord As New Word.Application Dim MyDoc As New Word.Document Application.ScreenUpdating = False If cb_mode.Value > 2 Then ReDim iData(ListBox1.ListCount, 3) As Variant J = 0 With ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) = True Then J = J + 1 iData(J, 1) = CStr(.List(i, 1)) iData(J, 2) = Val(.List(i, 7)) iData(J, 3) = Val(.List(i, 9)) End If Next End With Else ReDim iData(1, 3) As Variant J = CB_RR.ListIndex iData(1, 1) = CB_RR.List(J, 0) iData(1, 2) = Val(CB_RR.List(J, 1)) iData(1, 3) = Val(CB_RR.List(J, 2)) J = 1 End If Form_Print.Hide If J > 0 Then MyWord.Documents.Open "d:\cost\收货单.doc", Passworddocument:="COST" Set MyDoc = MyWord.Documents("收货单") Cnn.Open Driver_Cost For B = 1 To J If MsgBox("确定打印" & iData(B, 1) & "收货单请按"yes"", vbYesNo) = vbYes Then With MyDoc.Tables(1) .Cell(3, 2).Range.Delete .Cell(3, 4).Range.Delete .Cell(3, 6).Range.Delete .Cell(2, 5).Range.Delete .Cell(16, 6).Range.Delete For i = 6 To 15 For A = 1 To 6 .Cell(i, A).Range.Delete Next Next End With For A = 1 To 2 CC.Cmd_Val = Array(Array(4, IIf(A = 1, "find_rr_base", "find_rr"), 2, 1), _ Array("irrno", 200, 10, iData(B, 1)), _ Array("iFrom", 16, 0, 2)) With Rs If .EOF = False Then If A = 1 Then With MyDoc.Tables(1) .Cell(3, 2).Range.InsertAfter Rs!RR_PRNO .Cell(3, 4).Range.InsertAfter Rs!SUP_NAME .Cell(3, 6).Range.InsertAfter Rs!DE_NAME .Cell(2, 5).Range.InsertAfter Rs!RR_Date .Cell(16, 6).Range.InsertAfter Format(Rs!AMOUNT, "#0.00") End With Else i = 6 Do While .EOF = False With MyDoc.Tables(1) .Cell(i, 1).Range.InsertAfter Rs!RR_BINNO .Cell(i, 2).Range.InsertAfter Rs!ST_NAME & IIf(Len(Rs!ST_SIZE) >0, "/" & Rs!ST_SIZE, "") & IIf(Len(Rs!ST_MAKE) > 0, "/"& Rs!ST_MAKE, "") .Cell(i, 3).Range.InsertAfter Rs!ST_UNIT .Cell(i, 4).Range.InsertAfter Format(Rs!RR_QTY, "#0.00") .Cell(i, 5).Range.InsertAfter Format(Rs!RR_COST, "#0.000") .Cell(i, 6).Range.InsertAfter Format(Rs!AMOUNT, "#0.00") End With i = i + 1 .MoveNext Loop 'Cells(21, 3) = fun.DONG1(Cells(21, 7)) MyDoc.PrintOut Range:=wdPrintCurrentPage End If Else A = 3 End If .Close End With Next End If Next Set Rs = Nothing Cnn.Close Set Cnn = Nothing MyDoc.Close SaveChanges:=wdDoNotSaveChanges MyWord.Quit Set MyDoc = Nothing Set MyWord = Nothing ThisWorkbook.Activate End If End Sub

守柔

我粗看了一下，你还是原来的单元格中写数据吧。

不用这样先清空再写，只要如mydoc.tables(1).cell(2,3).range=Rs!RR_PRNO就可以了

否则，先清空，再插入，等于程序执行了二次，多累啊？

你再试一下？

wjd74

表头可以这样做，但之后的是10行*6列的表格，每张单据都不一定是10行，所以必须先删除原数据，再写入新数据

守柔

既然你的WORD文档无须保存，那么，表格中的单元格除了必需的固定的多外，其余部分都应该是空的。

当程序写入后，打印结束，不保存，为什么还存在下一次调用WORD时，还要删除呢？