VB6打印通过Excel和select两台打印机之一

我广泛地search了解决问题的方法,但是我担心它坐在我的前面,我看不到它。

问题:我有一个调用excel的VB6应用程序,并使用一个excel文件作为数据库来从第二张表中拉取地址,并将地址放入我需要打印的“地址标签”中。 这大大减less了地址中的打字错误,并使我可以通过自动创buildPALLET X OF X来加速这一过程。所以,只要默认打印机是托盘标签需要打印的打印机上。 我想在这个程序中join第二个样式标签,我已经成功完成了这个任务。 该程序将调用并填写所有必需的信息,并根据select的选项,它将打印两个Excel模板之一。

我遇到的问题是,我不能为我的生活得到它打印到一台打印机的大标签,同时也打印到小标签打印机的另一个标签。 我已经成功创build了一个独立的程序,我可以打印到任何打印机,但我不能让我的标签应用程序来做到这一点。 我有一种感觉与Excel的应用程序设置或东西有关。 在我认为是正确的位置(command3button)程序中列出了独立程序使用的打印机名称,

Option Explicit Dim SelectAll As Integer Dim location As String Dim location2 As String Dim loadedlist As Integer Dim big_small As String Dim prt As Printer 'trying to preload excel Dim excel_app As Excel.Application Dim workbook As Excel.workbook Dim sheet As Excel.Worksheet Dim ws As Excel.Worksheet Private Sub cmdframeclose_Click() SelectAll = List9.ListIndex List1.ListIndex = SelectAll List2.ListIndex = SelectAll List3.ListIndex = SelectAll List4.ListIndex = SelectAll List5.ListIndex = SelectAll 'set text box with text Text1.Text = List9.Text Text2.Text = List1.Text Text3.Text = List2.Text & ", " & List3.Text & " " & List4.Text Text4.Text = List5.Text 'auto hide frame after selection Frame1.Visible = False End Sub Private Sub CMDPRINT_Click() 'check for empty boxes If Text1.Text = "" Then MsgBox "please enter a customer name" Text1.SetFocus Exit Sub End If If Text2.Text = "" Then MsgBox "please enter a street address" Text2.SetFocus Exit Sub End If If Text3.Text = "" Then MsgBox "please enter a city, state and zip" Text3.SetFocus Exit Sub End If If Text4.Text = "" Then MsgBox "please enter customer contact info" Text4.SetFocus Exit Sub End If If Text5.Text = "" Then MsgBox "please enter msu number" Text5.SetFocus Exit Sub End If If Text6.Text = "" Then MsgBox "please enter number of pallets" Text6.SetFocus Exit Sub End If If Option1.Value = True Then 'check path for blank sheet to work with big_small = "G15" If Text8.Text <> "" Then location2 = Text8.Text & "\" & "Pallet_Sheet.xlsx" Else MsgBox "Please Input a valid data path" Text7.SetFocus Exit Sub End If 'set the printer to the correct one for the document, ***doesnt work*** 'Set Printer = Printers("\\ms-nauss-app1\MS-NAUSSA-PRN06") Else 'check path for blank sheet to work with big_small = "B8" If Text8.Text <> "" Then location2 = Text11.Text & "\" & "Small_Pallet_Label.xlsx" Else MsgBox "Please Input a valid data path" Text7.SetFocus Exit Sub End If 'set the printer to the correct one for the document, doesnt work 'Set Printer = Printers("ZDesigner GK420d") End If 'OPEN EXCEL ' Get the Excel application object. Set excel_app = New Excel.Application ' Make Excel visible (optional). excel_app.Visible = False ' Open the workbook read-only. Set workbook = excel_app.Workbooks.Open(location2, ReadOnly:=True) ' Get the first worksheet. Set ws = workbook.Sheets(1) If Option1.Value = True Then 'Fill in the cells with data large label ws.range("C3").Value = Text1.Text ws.range("C4").Value = Text2.Text ws.range("C5").Value = Text3.Text ws.range("C6").Value = Text4.Text ws.range("E11").Value = Text5.Text ws.range("I15").Value = Text6.Text Else 'fill in the cells with data small label ws.range("B3").Value = Text1.Text ws.range("B4").Value = Text2.Text ws.range("B5").Value = Text3.Text ws.range("B6").Value = Text4.Text ws.range("B7").Value = Text5.Text ws.range("D8").Value = Text6.Text End If 'create pallet numnbering x of x Dim p As Integer Application.ScreenUpdating = False ws.range(big_small).Value = "1" 'create and increment the pallet labels For p = 0 To (Text6.Text - 1) ws.Copy Before:=ws ws.range(big_small).Value = (p + 1) Next p 'create pallet excel document sheets x of x 'Dim ws As Worksheet Dim i As Integer i = 0 For Each ws In workbook.Worksheets If (i = 0) Then ws.Select Else ws.Select False End If i = i + 1 ws.PrintOut Next ws 'delete and clear screen for next shipping address ' Application.ScreenUpdating = False Application.DisplayAlerts = False ''For Each ws In Worksheets For Each ws In workbook.Worksheets If ws.Name <> "Sheet1" Then ws.Delete Next Set ws = workbook.Sheets(1) Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Text5.Text = "" Text6.Text = "" ' Application.ScreenUpdating = False workbook.Close SaveChanges:=False ' Close the Excel server. excel_app.Quit End Sub Private Sub Command1_Click() If Text7.Text <> "" Then location = Text7.Text & "\" & "addresses.xlsx" Else MsgBox "Please Input a valid data path" Text7.SetFocus Exit Sub End If Frame1.Visible = True List9.SetFocus cmdframeclose.Default = True If loadedlist = 0 Then loadedlist = 1 ' Get the Excel application object. Set excel_app = New Excel.Application ' Make Excel visible (optional). ' excel_app.Visible = False ' Open the workbook read-only. Set workbook = excel_app.Workbooks.Open(location, ReadOnly:=True) ' Get the first worksheet. Set sheet = workbook.Sheets(1) ' Get the titles and values. SetTitleAndListValues sheet, 1, 1, List9 SetTitleAndListValues sheet, 1, 2, List1 SetTitleAndListValues sheet, 1, 3, List2 SetTitleAndListValues sheet, 1, 4, List3 SetTitleAndListValues sheet, 1, 5, List4 SetTitleAndListValues sheet, 1, 6, List5 ' Save the changes and close the workbook. workbook.Close SaveChanges:=False ' Close the Excel server. excel_app.Quit Else Exit Sub End If List9.SetFocus End Sub ' Set a title Label and the values in a ListBox. Get the title from cell (row, col). ' Get the values from cell (row + 1, col) to the end of the column. Private Sub SetTitleAndListValues(ByVal sheet As Excel.Worksheet, _ ByVal row As Integer, ByVal col As Integer, ByVal lst As ListBox) Dim range As Excel.range Dim last_cell As Excel.range Dim first_cell As Excel.range Dim value_range As Excel.range Dim range_values() As Variant Dim num_items As Integer Dim i As Integer ' Get the values. ' Find the last cell in the column. Set range = sheet.Columns(col) Set last_cell = range.End(xlDown) ' Get a Range holding the values. Set first_cell = sheet.Cells(row + 1, col) Set value_range = sheet.range(first_cell, last_cell) ' Get the values. range_values = value_range.Value ' Convert this into a 1-dimensional array. ' Note that the Range's array has lower bounds 1. num_items = UBound(range_values, 1) For i = 1 To num_items lst.AddItem range_values(i, 1) Next i End Sub Private Sub Command3_Click() Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Text5.Text = "" Text6.Text = "" Text1.SetFocus End Sub Private Sub Command4_Click() ' Close the Excel server. excel_app.Quit End End Sub Private Sub Form_Load() Frame1.Visible = False Dim file_name As String file_name = Application.StartupPath End Sub Private Sub List9_dblClick() SelectAll = List9.ListIndex List1.ListIndex = SelectAll List2.ListIndex = SelectAll List3.ListIndex = SelectAll List4.ListIndex = SelectAll List5.ListIndex = SelectAll 'set text box with text Text1.Text = List9.Text Text2.Text = List1.Text Text3.Text = List2.Text & ", " & List3.Text & " " & List4.Text Text4.Text = List5.Text 'auto hide frame after selection Frame1.Visible = False CMDPRINT.Default = True End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 27 Then Frame1.Visible = False End If If KeyCode = 38 Then If List9.ListIndex > -1 Then List9.ListIndex = List9.ListIndex - 1 'update listboxes SelectAll = List9.ListIndex List1.ListIndex = SelectAll List2.ListIndex = SelectAll List3.ListIndex = SelectAll List4.ListIndex = SelectAll List5.ListIndex = SelectAll 'set text box with text Text1.Text = List9.Text Text2.Text = List1.Text Text3.Text = List2.Text & ", " & List3.Text & " " & List4.Text Text4.Text = List5.Text End If ElseIf KeyCode = 40 Then If List9.ListIndex < List9.ListCount - 1 Then List9.ListIndex = List9.ListIndex + 1 'update listboxes SelectAll = List9.ListIndex List1.ListIndex = SelectAll List2.ListIndex = SelectAll List3.ListIndex = SelectAll List4.ListIndex = SelectAll List5.ListIndex = SelectAll 'set text box with text Text1.Text = List9.Text Text2.Text = List1.Text Text3.Text = List2.Text & ", " & List3.Text & " " & List4.Text Text4.Text = List5.Text End If ElseIf KeyCode = 13 Then 'update listboxes SelectAll = List9.ListIndex List1.ListIndex = SelectAll List2.ListIndex = SelectAll List3.ListIndex = SelectAll List4.ListIndex = SelectAll List5.ListIndex = SelectAll 'set text box with text Text1.Text = List9.Text Text2.Text = List1.Text Text3.Text = List2.Text & ", " & List3.Text & " " & List4.Text Text4.Text = List5.Text Frame1.Visible = False End If End Sub 

事件:

  1. 加载用户文本框和button的主屏幕
  2. “加载客户”加载一个包含所有地址的combobox,并让我根据客户名称select一个完整的地址。 通过双击你想要的comboboxselect
  3. 所有的地址都加载在主屏幕上的文本框中,可以根据需要进行validation和/或调整。
  4. input货件上的订单号码和托盘数量。
  5. 点击打印(这是我想要改变的地方,我需要它打印到正确的打印机基于两个添加的选项button)如果有任何数据丢失的程序会提示你,并将焦点设置为文本框是缺less数据。
  6. 数据被添加到excel模板中,创build正确数量的标签(x的托盘x)并将其打印。
  7. 表格清除自己,现在准备好再次使用。

任何和所有的帮助将不胜感激。

谢谢

………………………………编辑…………. …………………………………………

晚上睡好之后,我意识到了一些事情。 如果我通过VB6调用Excel应用程序,那么在VB6中更改打印机可能不会影响Excel中的打印机。 我知道工作簿对象的额外function。 我试图设置打印机,但不断收到相同的错误信息。

ws.printout(activeprinter:=“ZDesigner GK420d”)

当我完成键入的代码行,我得到的错误消息“预期的错误:=”据我所知,我已经完成了正确的代码行。 还有很多更多的function可以完成。 在过去,我用这个来打印多个东西的副本,甚至一次,甚至设置双工….所有在默认打印机,但。

感谢你的宝贵时间。

尝试没有括号,如下所示:

 ws.printout activeprinter:="ZDesigner GK420d" 

PrintOut方法不返回一个值,所以你不能像使用一个函数(返回一个值)那样使用小括号,至less这样做。