Visual Basic 4 / 5 / 6 RSS Visual Basic 4 / 5 / 6 RSS

VB6 - Programatically tell excel to print only the area that has data.

Reply

•
•
Join Date: Jul 2007
Posts: 113
Reputation: tgifgemini is an unknown quantity at this point 
Solved Threads: 0
tgifgemini tgifgemini is offline Offline
Junior Poster

VB6 - Programatically tell excel to print only the area that has data.

 
0
  #1
Sep 21st, 2007
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:
Visual Basic 4 / 5 / 6 Syntax (Toggle Plain Text) 
  1. Set M.qBW = M.DB.OpenRecordset("qBiWeeklyPeriodProgrammer", dbOpenDynaset)
  2.     Set rsinPers = M.DB.OpenRecordset("TblPersonnel", dbOpenDynaset)
  3.     Set rsSrtSelStr = M.DB.OpenRecordset("TblSelectionString", dbOpenDynaset)
  4.  
  5.     Set xlApp = CreateObject("Excel.Application")
  6.     Set xlWbk = xlApp.Workbooks.Open("C:\BiWeeklyPeriodProg.xls")
  7.     Set xlWksht = xlWbk.Worksheets(1)
  8.  
  9.     M.qBW.Sort = "Req No"
  10.  
  11.     xlWksht.Activate
  12.     xlWksht.UsedRange.ClearContents
  13.  
  14.     xlWksht.Cells(2, 1).Value = rsSrtSelStr![SelectionString]
  15.     xlWksht.Cells(3, 1).Value = rsSrtSelStr![SortString]
  16.  
  17.     xlWksht.Range("A2:F2").MergeCells = True
  18.     xlWksht.Range("A3:F3").MergeCells = True
  19.  
  20.     'Write Spreadsheet headers:
  21.     '--------------------------
  22.     ii = 4
  23.     ii = ii + 1
  24.     xlWksht.Cells(ii, 1).Value = Chr(10) & "Req" & Chr(10) & "No"
  25.     xlWksht.Cells(ii, 2).Value = Chr(10) & Chr(10) & "Description"
  26.     xlWksht.Cells(ii, 3).Value = ""
  27.     xlWksht.Cells(ii, 4).Value = Chr(10) & "Client Name" & Chr(10) & "& Status"
  28.     xlWksht.Cells(ii, 5).Value = Chr(10) & "PL" & Chr(10) & "Hrs"
  29.     xlWksht.Cells(ii, 6).Value = Chr(10) & "Pr2" & Chr(10) & "Hrs"
  30.     xlWksht.Cells(ii, 7).Value = Chr(10) & "Pr3" & Chr(10) & "Hrs"
  31.     xlWksht.Cells(ii, 8).Value = Chr(10) & "Pr4" & Chr(10) & "Hrs"
  32.     xlWksht.Cells(ii, 9).Value = Chr(10) & "Pr5" & Chr(10) & "Hrs"
  33.     xlWksht.Cells(ii, 10).Value = Chr(10) & "Pr6" & Chr(10) & "Hrs"
  34.     xlWksht.Cells(ii, 11).Value = Chr(10) & "Current" & Chr(10) & "Hours"
  35.     xlWksht.Cells(ii, 12).Value = "Estimated" & Chr(10) & "Actual" & Chr(10) & "Tot Hrs"
  36.     xlWksht.Cells(ii, 13).Value = "Estimated" & Chr(10) & "Actual" & Chr(10) & "Start Date"
  37.     xlWksht.Cells(ii, 14).Value = "Estimated" & Chr(10) & "Actual" & Chr(10) & "End Date"
  38.  
  39.     'Format spreadsheet headers:
  40.     '---------------------------
  41.     xlWksht.Range("A5:N5").Select
  42.     With Selection.Font
  43.         .FontStyle = "Bold"
  44.         .Size = 8
  45.         .Underline = xlUnderlineStyleDouble
  46.     End With
  47.  
  48.     xlWksht.Range("A:A").Font.Bold = True
  49.  
  50.     xlWksht.Range("A:A").HorizontalAlignment = xlLeft
  51.     xlWksht.Rows("5:5").RowHeight = 42.75
  52.     xlWksht.Range("A:A").ColumnWidth = 5
  53.     xlWksht.Columns("B").ColumnWidth = 27
  54.     xlWksht.Columns("C:C").ColumnWidth = 3.86
  55.     xlWksht.Columns("D:D").ColumnWidth = 10.71
  56.     xlWksht.Columns("D:D").HorizontalAlignment = xlLeft
  57.     xlWksht.Columns("E:J").ColumnWidth = 3
  58.     xlWksht.Columns("K:K").ColumnWidth = 6.14
  59.     xlWksht.Columns("L:N").ColumnWidth = 10
  60.  
  61.     'Populate Spreadsheet:
  62.     '---------------------
  63.     M.qBW.MoveFirst
  64.     rsinPers.MoveFirst
  65.  
  66.     ii = 5
  67.      w = 0
  68.     For Each R In xlWksht.Range("A5:N5"): w = w + R.ColumnWidth: Next
  69.  
  70.     rht = xlWksht.Range("A5").RowHeight
  71.  
  72.     Do Until M.qBW.EOF = True
  73.         ii = ii + 2
  74.         xlWksht.Cells(ii, 1).Value = M.qBW![Req No]
  75.         xlWksht.Cells(ii, 2).Value = M.qBW![Description]
  76.         xlWksht.Cells(ii, 3).Value = ""
  77.         xlWksht.Cells(ii, 4).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status]
  78.         xlWksht.Cells(ii, 5).Value = M.qBW![P L] & Chr(10) & M.qBW![TotalProg1Hrs]
  79.  
  80.         SrchCriteria = "[Name]= " & "'" & M.qBW![Personnel2] & "'"
  81.         rsinPers.FindFirst SrchCriteria
  82.         If rsinPers.NoMatch = False Then
  83.            xlWksht.Cells(ii, 6).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs]
  84.         End If
  85.  
  86.         SrchCriteria = "[Name]= '" & M.qBW![Personnel3] & "'"
  87.         rsinPers.FindFirst SrchCriteria
  88.         If rsinPers.NoMatch = False Then
  89.            xlWksht.Cells(ii, 7).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg3Hrs]
  90.         End If
  91.  
  92.         SrchCriteria = "[Name]= '" & M.qBW![Personnel4] & "'"
  93.         rsinPers.FindFirst SrchCriteria
  94.         If rsinPers.NoMatch = False Then
  95.            xlWksht.Cells(ii, 8).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg4Hrs]
  96.         End If
  97.  
  98.         SrchCriteria = "[Name]= '" & M.qBW![Personnel5] & "'"
  99.         rsinPers.FindFirst SrchCriteria
  100.         If rsinPers.NoMatch = False Then
  101.            xlWksht.Cells(ii, 9).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg5Hrs]
  102.         End If
  103.  
  104.         SrchCriteria = "[Name]= '" & M.qBW![Personnel6] & "'"
  105.         rsinPers.FindFirst SrchCriteria
  106.         If rsinPers.NoMatch = False Then
  107.            xlWksht.Cells(ii, 10).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hrs]
  108.         End If
  109.  
  110.         xlWksht.Cells(ii, 11).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs")
  111.         xlWksht.Cells(ii, 12).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs")
  112.         xlWksht.Cells(ii, 13).Value = M.qBW![Start Date] & Chr(10) & M.qBW![Start Date]
  113.         xlWksht.Cells(ii, 14).Value = M.qBW![End Date] & Chr(10) & M.qBW![End  Date]
  114.  
  115.         If M.qBW![Comments] = "" Or IsNull(M.qBW![Comments]) Then
  116.            mystr = "Comments:" & Chr(10) & "NO COMMENTS FOR THIS RECORD!"
  117.         Else
  118.            mystr = "Comments:" & "'" & xlApp.Clean(Trim(M.qBW![Comments]))
  119.         End If
  120.  
  121.         Do
  122.             Pos = InStr(Pos + 1, mystr, ":")
  123.             If Not Pos = 0 Then
  124.                If Mid(mystr, Pos - 5, 1) = "/" Then
  125.                    mystr = Left(mystr, Pos - 11) & Chr(10) & Mid(mystr, Pos - 10, 10) & Chr(10) & Mid(mystr, Pos + 1)
  126.                    Pos = Pos + 2
  127.                End If
  128.             End If
  129.         Loop While Not Pos = 0
  130.  
  131.         xlWksht.Cells(ii + 1, 1).Value = "Comments:" 'Left(mystr, 10)
  132.         xlWksht.Cells(ii + 1, 2).Value = Mid(mystr, 11)
  133.  
  134.                           'Note: changed(ii + 1, 1) to (ii + 1, 2)
  135.         With xlWksht.Range(xlWksht.Cells(ii + 1, 2), xlWksht.Cells(ii + 1, 14))
  136.             .HorizontalAlignment = xlLeft
  137.             .VerticalAlignment = xlTop
  138.             .WrapText = True
  139.             .Orientation = 0
  140.             .MergeCells = True
  141.             .RowHeight = .Font.Size * (Len(xlWksht.Range("A" & ii + 2).text) - Len("Comments:")) / w + rht + (rht - .Font.Size) ' + newlinecnt * .Font.Size
  142.         End With              
  143.  
  144.         xlWksht.Columns("A:A").ColumnWidth = 9.15
  145.  
  146.         TStr = "A" & CStr(ii + 1) & ":N" & CStr(ii + 1)
  147.         xlWksht.Range(TStr).Select
  148.         If Not IsEmpty(Selection.Range("A1")) Then 'check if first cell is empty
  149.            With xlWksht.Range(TStr).Borders(xlEdgeBottom)
  150.            .LineStyle = xlDouble
  151.            .Weight = xlThin
  152.            .ColorIndex = xlAutomatic
  153.            End With
  154.         End If
  155.         M.qBW.MoveNext
  156.     Loop
  157.  
  158.  
  159. xlApp.ActiveWorkbook.Save
tgif
Reply With Quote Quick reply to this message  
Reply

Quick Reply to Thread
This thread is more than three months old.
Perhaps start a new thread instead?
•
•
•
•
•
•
•
•
Message:
•
•
•
•



Similar Threads
Other Threads in the Visual Basic 4 / 5 / 6 Forum
Thread Tools Search this Thread



* 6 429 2007 access activex add age application basic beginner birth bmp calculator cd cells.find click client code college component connection connectionproblemusingvb6usingoledb copy creat ctrl+f data database datareport date delete dissertations dissertationthesis dissertationtopic edit error excel excelmacro file filename form hardware header iamthwee image inboxinvb internetfiledownload keypress label listbox listview liveperson login looping machine microsoft movingranges number objectinsert open oracle password prime program prompt range-objects readfile reading record refresh remotesqlserverdatabase report save search sendbyte sites sort sql sql2008 sqlserver subroutine tags textbox time urldownloadtofile vb vb6 vb6.0 vba visual visualbasic visualbasic6 web window windows
About Us | Contact Us | Advertise | DaniWeb | Acceptable Use Policy | RSS Feed

©2003 - 2009 DaniWeb® LLC