VB6 printing via Excel and choosing one of the two printers
I have searched many times for a solution to my problem, but I am afraid that his meeting is in front of me and I do not see it.
Problem: I have a VB6 app that calls excel and uses one excel file as a database to pull addresses and a second sheet to put the address in the "address labels" I need to print. This has greatly reduced address typing errors and made it possible to speed up the process by automating the creation of PALLET X OF X. So it all works great if the default printer is the one that is to be printed with the pallet label on. I would like to include a second style shortcut in this program, and I did it successfully. the program will call up and fill in all the necessary information, and depending on the option selected, it will print with one of the two excel templates.
The problem is that I can't for life get it to print a big mark on one printer, and also print another mark on a small printer. I have successfully created a standalone program that I can print to any printer I need, but I cannot get an app for my shortcuts. I have a feeling it has something to do with the excel.application settings or something else. the names of the printers that are used in the standalone program are listed in the program by what I thought was the correct place (command3 button)
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 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
Events:
- load home screen with text fields and user buttons
- "load customer" loads a combo box with all addresses and allows me to select a complete address based on the customer's name. double-clicking the desired combo box.
- the entire address is loaded into text boxes on the home screen, which can be checked and / or customized as needed.
- enter the order number and the number of pallets to be shipped.
- click print (this is exactly where I want to change. I need it to print to the correct printer based on the two extra buttons added.) If any data is missing, the program will prompt you and also set focus to the text that is missing data.
- the data is appended to the excel template, the correct number of labels are created (substitute x of x) and they are printed. The form
- cleared and is now ready to use again.
Any help is greatly appreciated.
thank
.................................... EDIT ............. ................................................
After a good night's sleep, I realized something. If I call the excel application through VB6, then changing the printer in VB6 may not affect the printer in excel. I am aware of the advanced features of the book object. I tried to install the printer but kept getting the same error message.
ws.printout (activeprinter: = "ZDesigner GK420d")
as i finish typing the line of code i get the error "error expected: =" As far as i know i have executed the line of code correctly. there are many more other functions that can be done with it. I've used this in the past to print multiple copies of material and once even set duplex ... all on my default printer.
Thanks again for your time.
source to share