Hello everyone,
I am creating an excel spreadsheet using VB 6.0. After running my program, I may process either one or more records, but when I printView and initiate a print, it prints the page with one or more records and prints additional unnecessary blank pages.
How can I programatically tell it to print only the range that has data in it?
Here is my codes:
Set M.qBW = M.DB.OpenRecordset("qBiWeeklyPeriodProgrammer", dbOpenDynaset)
Set rsinPers = M.DB.OpenRecordset("TblPersonnel", dbOpenDynaset)
Set rsSrtSelStr = M.DB.OpenRecordset("TblSelectionString", dbOpenDynaset)
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Open("C:\BiWeeklyPeriodProg.xls")
Set xlWksht = xlWbk.Worksheets(1)
M.qBW.Sort = "Req No"
xlWksht.Activate
xlWksht.UsedRange.ClearContents
xlWksht.Cells(2, 1).Value = rsSrtSelStr![SelectionString]
xlWksht.Cells(3, 1).Value = rsSrtSelStr![SortString]
xlWksht.Range("A2:F2").MergeCells = True
xlWksht.Range("A3:F3").MergeCells = True
'Write Spreadsheet headers:
'--------------------------
ii = 4
ii = ii + 1
xlWksht.Cells(ii, 1).Value = Chr(10) & "Req" & Chr(10) & "No"
xlWksht.Cells(ii, 2).Value = Chr(10) & Chr(10) & "Description"
xlWksht.Cells(ii, 3).Value = ""
xlWksht.Cells(ii, 4).Value = Chr(10) & "Client Name" & Chr(10) & "& Status"
xlWksht.Cells(ii, 5).Value = Chr(10) & "PL" & Chr(10) & "Hrs"
xlWksht.Cells(ii, 6).Value = Chr(10) & "Pr2" & Chr(10) & "Hrs"
xlWksht.Cells(ii, 7).Value = Chr(10) & "Pr3" & Chr(10) & "Hrs"
xlWksht.Cells(ii, 8).Value = Chr(10) & "Pr4" & Chr(10) & "Hrs"
xlWksht.Cells(ii, 9).Value = Chr(10) & "Pr5" & Chr(10) & "Hrs"
xlWksht.Cells(ii, 10).Value = Chr(10) & "Pr6" & Chr(10) & "Hrs"
xlWksht.Cells(ii, 11).Value = Chr(10) & "Current" & Chr(10) & "Hours"
xlWksht.Cells(ii, 12).Value = "Estimated" & Chr(10) & "Actual" & Chr(10) & "Tot Hrs"
xlWksht.Cells(ii, 13).Value = "Estimated" & Chr(10) & "Actual" & Chr(10) & "Start Date"
xlWksht.Cells(ii, 14).Value = "Estimated" & Chr(10) & "Actual" & Chr(10) & "End Date"
'Format spreadsheet headers:
'---------------------------
xlWksht.Range("A5:N5").Select
With Selection.Font
.FontStyle = "Bold"
.Size = 8
.Underline = xlUnderlineStyleDouble
End With
xlWksht.Range("A:A").Font.Bold = True
xlWksht.Range("A:A").HorizontalAlignment = xlLeft
xlWksht.Rows("5:5").RowHeight = 42.75
xlWksht.Range("A:A").ColumnWidth = 5
xlWksht.Columns("B").ColumnWidth = 27
xlWksht.Columns("C:C").ColumnWidth = 3.86
xlWksht.Columns("D:D").ColumnWidth = 10.71
xlWksht.Columns("D:D").HorizontalAlignment = xlLeft
xlWksht.Columns("E:J").ColumnWidth = 3
xlWksht.Columns("K:K").ColumnWidth = 6.14
xlWksht.Columns("L:N").ColumnWidth = 10
'Populate Spreadsheet:
'---------------------
M.qBW.MoveFirst
rsinPers.MoveFirst
ii = 5
w = 0
For Each R In xlWksht.Range("A5:N5"): w = w + R.ColumnWidth: Next
rht = xlWksht.Range("A5").RowHeight
Do Until M.qBW.EOF = True
ii = ii + 2
xlWksht.Cells(ii, 1).Value = M.qBW![Req No]
xlWksht.Cells(ii, 2).Value = M.qBW![Description]
xlWksht.Cells(ii, 3).Value = ""
xlWksht.Cells(ii, 4).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status]
xlWksht.Cells(ii, 5).Value = M.qBW![P L] & Chr(10) & M.qBW![TotalProg1Hrs]
SrchCriteria = "[Name]= " & "'" & M.qBW![Personnel2] & "'"
rsinPers.FindFirst SrchCriteria
If rsinPers.NoMatch = False Then
xlWksht.Cells(ii, 6).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs]
End If
SrchCriteria = "[Name]= '" & M.qBW![Personnel3] & "'"
rsinPers.FindFirst SrchCriteria
If rsinPers.NoMatch = False Then
xlWksht.Cells(ii, 7).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg3Hrs]
End If
SrchCriteria = "[Name]= '" & M.qBW![Personnel4] & "'"
rsinPers.FindFirst SrchCriteria
If rsinPers.NoMatch = False Then
xlWksht.Cells(ii, 8).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg4Hrs]
End If
SrchCriteria = "[Name]= '" & M.qBW![Personnel5] & "'"
rsinPers.FindFirst SrchCriteria
If rsinPers.NoMatch = False Then
xlWksht.Cells(ii, 9).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg5Hrs]
End If
SrchCriteria = "[Name]= '" & M.qBW![Personnel6] & "'"
rsinPers.FindFirst SrchCriteria
If rsinPers.NoMatch = False Then
xlWksht.Cells(ii, 10).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hrs]
End If
xlWksht.Cells(ii, 11).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs")
xlWksht.Cells(ii, 12).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs")
xlWksht.Cells(ii, 13).Value = M.qBW![Start Date] & Chr(10) & M.qBW![Start Date]
xlWksht.Cells(ii, 14).Value = M.qBW![End Date] & Chr(10) & M.qBW![End Date]
If M.qBW![Comments] = "" Or IsNull(M.qBW![Comments]) Then
mystr = "Comments:" & Chr(10) & "NO COMMENTS FOR THIS RECORD!"
Else
mystr = "Comments:" & "'" & xlApp.Clean(Trim(M.qBW![Comments]))
End If
Do
Pos = InStr(Pos + 1, mystr, ":")
If Not Pos = 0 Then
If Mid(mystr, Pos - 5, 1) = "/" Then
mystr = Left(mystr, Pos - 11) & Chr(10) & Mid(mystr, Pos - 10, 10) & Chr(10) & Mid(mystr, Pos + 1)
Pos = Pos + 2
End If
End If
Loop While Not Pos = 0
xlWksht.Cells(ii + 1, 1).Value = "Comments:" 'Left(mystr, 10)
xlWksht.Cells(ii + 1, 2).Value = Mid(mystr, 11)
'Note: changed(ii + 1, 1) to (ii + 1, 2)
With xlWksht.Range(xlWksht.Cells(ii + 1, 2), xlWksht.Cells(ii + 1, 14))
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.MergeCells = True
.RowHeight = .Font.Size * (Len(xlWksht.Range("A" & ii + 2).text) - Len("Comments:")) / w + rht + (rht - .Font.Size) ' + newlinecnt * .Font.Size
End With
xlWksht.Columns("A:A").ColumnWidth = 9.15
TStr = "A" & CStr(ii + 1) & ":N" & CStr(ii + 1)
xlWksht.Range(TStr).Select
If Not IsEmpty(Selection.Range("A1")) Then 'check if first cell is empty
With xlWksht.Range(TStr).Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
M.qBW.MoveNext
Loop
xlApp.ActiveWorkbook.Savetgif