Hello, I have copied and pasted the macro below that was written in order
that a worksheet printed. I would like it to continue functioning as it
does but no longer printing but cannot fathom which parts to remove in
order that this happen....
Sub New_job()
'
'
Dim ttdate As String
Dim ttref As String
Dim ttrefnum As Integer
Dim ttcustomer As String
Dim ttdate1 As String
Dim ttroute As String
Dim MyOBJ As Object
tprinter = "HP LaserJet 200 color MFP M276 PCL 6 on Ne02:"
start_prog:
On Error GoTo error_handler
z_input = "S:\GROUP RESOURCES FOLDER\Template
Artwork\1.Jobs\TTTemplate.xlsx"
ttroute = "S:\GROUP RESOURCES FOLDER\Template Artwork\1.Jobs\"
ttroute2 = "S:\GROUP RESOURCES FOLDER\Template Artwork\"
'z_input = "H:\1.Jobs\TTTemplate.xlsx"
'ttroute = "H:\1.Jobs\"
'ttroute2 = "H:\"
kounter = 0
zq = Environ("username")
For j = 1 To Len(zq)
zx = Mid(zq, j, 1)
If zx = "." Then
kounter = j
End If
Next j
If kounter = 0 Then
kounter = Len(zq) + 1
End If
zq = Left(zq, kounter - 1)
If zq = "Karen" Or zq = "kfriis" Then
zq = "Kaz"
End If
If zq = "IWOfficeUser1" Then
zq = "Liam"
End If
Application.Goto reference:="r7c4"
ttref = ActiveCell.Offset(0, 0)
tecode = ActiveCell.Offset(0, -3)
Application.Goto reference:="r9c2"
ttdate = ActiveCell.Offset(0, 0)
ttcustomer = ActiveCell.Offset(1, 0)
' ****** added section ******
If ttref = "IW" Or Len(ttref) < 3 Or Len(ttref) > 6 Then
MsgBox "There must be a valid reference number", vbOKOnly
GoTo apg_blank
End If
If ttdate = "" Then
MsgBox "You must enter a date", vbOKOnly
GoTo apg_blank
End If
If ttcustomer = "" Then
MsgBox "You must enter a customer", vbOKOnly
GoTo apg_blank
End If
' ****** added section end ******
ttdate1 = Mid(ttdate, 4, 2) + "/" + Left(ttdate, 2) + "/" + Right(ttdate, 2)
TPrint ttref, ttroute, tprinter, tecode
'ok
Windows("Template Job Sheet.xlsm").Activate
' Windows("Template Job Sheet.xls").Activate 'my pc
zz = 3
deleter:
jsdelete
Range("a4").Select
twrite_tracker ttroute2, ttref, ttcustomer, ttdate1, zq 'added *******
'MsgBox "The new template job sheet has been saved, printed and copied to
template tracker", vbOKOnly
Application.DisplayAlerts = False
ActiveWorkbook.Save
'ActiveWorkbook.SaveAs Filename:=ttroute2 + "Template Job Sheet.xlsm",
FileFormat:= _
' xlNormal, Password:="tjobs", WriteResPassword:="",
ReadOnlyRecommended:=False _
' , CreateBackup:=False 'my pc
Application.DisplayAlerts = True
ActiveWindow.Close
apg_blank:
Exit Sub
error_handler:
If Err = 9 Then
MsgBox "Cannot open " & z_file, vbOKOnly
GoTo start_prog
Else
GoTo apg_quit
End If
apg_quit:
MsgBox "An error has occurred whilst executing this macro", vbOKOnly
zz = Err
Stop
End Sub
Function TPrint(ttref, ttroute, tprinter, tecode)
Range("A9").Select
Range("A9:D44").Select
Application.CutCopyMode = False
Selection.Copy
'Workbooks.Open Filename:=ttroute + "\TTTemplate.xlsx"
Application.DisplayAlerts = False
Workbooks.Open Filename:=ttroute + "TTTemplate.xlsx", Password:="ttemp"
'my pc
Application.DisplayAlerts = True
Range("d4").Select
ActiveCell.Offset(0, 0) = ttref
ActiveCell.Offset(0, -3) = tecode
Range("A6").Select
ActiveSheet.Paste
Range("B4").Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=ttroute + ttref + ".xlsx", FileFormat:=
_
xlOpenXMLWorkbook, Password:="", CreateBackup:=False
'ActiveWorkbook.SaveAs Filename:=ttroute + ttref + ".xls", FileFormat:= _
' xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
' , CreateBackup:=False 'my pc
ActiveWindow.SelectedSheets.PrintOut Copies:=1,
ActivePrinter:=tprinter, Collate:=True, _
IgnorePrintAreas:=False
ActiveWindow.Close
Range("B7").Select
End Function
Function twrite_tracker(ttroute2, ttref, ttcustomer, ttdate1, ttuser)
'Workbooks.Open Filename:=ttroute2 + "\Template Tracker.xlsx"
Workbooks.Open Filename:=ttroute2 + "Template Tracker.xlsx",
Password:="ttrack" 'my pc
'Workbooks.Open Filename:="H:\GROUP RESOURCES FOLDER\Template
Artwork\Template Tracker.xlsx"
Sheets("Active").Select
Application.Goto reference:="r2c1"
x = 0
While (x < 10000)
x = x + 1
'ActiveCell.Offset(1, 0).Activate
kontents = ActiveCell.Offset(x, 0)
If kontents = "" Then
kounter = x - 1
x = 10000
End If
Wend
ActiveCell.Offset(kounter + 1, 0).Activate
ActiveCell.Offset(0, 0) = ttref
ActiveCell.Offset(0, 1) = ttcustomer
ActiveCell.Offset(0, 2) = ttdate1
ActiveCell.Offset(0, 5) = ttuser
'Z = My.User.Name
ActiveWorkbook.Save
ActiveWindow.Close
End Function
Function jsdelete()
Range("B9:D13").Select
Selection.ClearContents
Range("A16:D16").Select
Range("A16:D35").Select
Selection.ClearContents
Range("B37:D38").Select
Selection.ClearContents
Range("A41:D44").Select
Selection.ClearContents
For Each pic In ActiveSheet.Shapes
If pic.Name <> "Picture 2" And pic.Name <> "Oval 1" And pic.Name <>
"Oval 3" And pic.Name <> "Oval 4" And pic.Name <> "Oval 5" Then
If InStr(1, pic.Name, "Err") <> 0 Then pic.Delete
End If
Next pic
Sheets("Sheet2").Select
Range("B1").Select
ttrefnum = ActiveCell.Offset(0, 0)
ttrefnum = ttrefnum + 1
ActiveCell.FormulaR1C1 = ttrefnum
Sheets("Sheet1").Select
ActiveWorkbook.Save
End Function
Function ttracker_sheet()
Range("B9:C9").Select
Selection.Copy
Windows("Template Tracker copy.xlsx").Activate
Range("C29").Select
ActiveSheet.Paste
Windows("Template Job Sheet.xlsm").Activate
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Template Tracker copy.xlsx").Activate
Range("A29").Select
Application.CutCopyMode = False
Windows("Template Job Sheet.xlsm").Activate
Selection.Copy
Windows("Template Tracker copy.xlsx").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Windows("Template Job Sheet.xlsm").Activate
Range("B10:C10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Template Tracker copy.xlsx").Activate
Range("B29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("C29").Select
Windows("Template Job Sheet.xlsm").Activate
Range("B9:C9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Template Tracker copy.xlsx").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("F29").Select
Application.CutCopyMode = False
Range("F29").Select
ActiveCell.FormulaR1C1 = "Jess "
ChDir "H:\"
ActiveWorkbook.SaveAs Filename:="H:\Template Tracker copy.xlsx",
FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
Windows("Template Job Sheet.xlsm").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Function
--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at https://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.
