【问题标题】:VB6 printing through excel and selecting one of two printersVB6通过excel打印并选择两台打印机之一
【发布时间】:2015-02-16 19:19:59
【问题描述】:

我广泛搜索解决我的问题的方法,但我担心它就在我面前,我看不到它。

问题:我有一个 VB6 应用程序,它调用 excel 并使用一个 excel 文件作为数据库从其中提取地址,并使用第二张表将地址放入我需要打印的“地址标签”中。这大大减少了地址中的输入错误,并允许我通过自动创建 PALLET X OF X 来加快流程。因此,只要默认打印机是需要打印托盘标签的打印机,所有这些都可以正常工作在。我想在这个程序中加入第二个风格标签,我已经成功地做到了。该程序将调用并填写所有必需的信息,并根据所选选项使用两个 Excel 模板之一进行打印。

我遇到的问题是,我无法将大标签打印到一台打印机,同时又将另一个标签打印到小标签打印机。我已经成功创建了一个独立程序,我可以随意打印到我想要​​的任何打印机,但我无法让我的标签应用程序执行此操作。我感觉它与 excel.application 设置或其他东西有关。独立程序使用的打印机名称列在程序中我认为正确的位置(command3 按钮)

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. 使用用户文本框和按钮加载主屏幕
  2. “加载客户”会加载一个包含所有地址的组合框,让我根据客户名称选择一个完整的地址。通过双击您想要的组合框选择
  3. 所有地址都加载在主屏幕的文本框中,可以根据需要进行验证和/或调整。
  4. 输入货件上的订单号和托盘数量。
  5. 单击打印(这是我想要更改的地方。我需要根据添加的两个选项按钮将其打印到正确的打印机。)如果缺少任何数据,程序将提示您并将焦点设置为文本缺少数据的框。
  6. 数据已添加到 Excel 模板,创建了正确数量的标签(托盘 x of x)并打印。
  7. 表单会自行清除,现在可以再次使用。

我们将不胜感激。

谢谢

........................编辑............ ..................................................... .

睡了一夜好觉后,我意识到了一些事情。如果我通过 VB6 调用 excel 应用程序,那么在 VB6 中更改打印机可能不会影响 excel 中的打印机。我确实知道工作簿对象的额外功能。我尝试设置打印机,但一直收到相同的错误消息。

ws.printout(activeprinter:="ZDesigner GK420d")

当我完成输入代码行时,我收到错误消息“预期错误:=”据我所知,我已经正确完成了代码行。还有很多更多的功能可以用它来完成。在过去,我用它来打印多份东西,甚至设置了双面打印......不过,所有这些都在默认打印机上。

再次感谢您的宝贵时间。

【问题讨论】:

    标签: excel networking printing vb6 silent


    【解决方案1】:

    不带括号试试,如:

    ws.printout activeprinter:="ZDesigner GK420d"
    

    PrintOut 方法不返回值,因此您不能像使用函数(返回值)那样使用括号,至少在这种情况下是这样。

    【讨论】:

    • 我回去工作后会检查这个。我确实觉得自己像个白痴,因为当我读到“...方法不返回...”时,我就意识到了我的逻辑错误。
    猜你喜欢
    • 1970-01-01
    • 2013-11-08
    • 1970-01-01
    • 2012-11-11
    • 2015-01-30
    • 1970-01-01
    • 2017-03-10
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多