By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
459,492 Members | 1,199 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 459,492 IT Pros & Developers. It's quick & easy.

Spreadsheet - Prints Blank Pages And Unnecessary Underlines

P: 7
Hellow everyone,
I am calling/manipulating Excel spreadsheet through VB 6.0. Most of my objectives are accomplished except some cosmetics.
Problem#1:
For example, after running my program to process a single record, when I proceed to print it, it prints the first page containing the processed record. It also prints 5 more blank pages without any record.

Problem#2:
Also, my intention is to print an Underline after writing each record, but the underlines are printed whether a record is written or not.

How can I get it to prints only the area that has data and draw an underline only when a record is processed and written?

Below is my entire module:


Expand|Select|Wrap|Line Numbers
  1.  
  2. ii = 5 
  3. w = 0 
  4. For Each R In xlWksht. Range("A5:N5"): w = w + R.ColumnWidth: Next 
  5.  
  6.     rht = xlWksht.Range("A5").RowHeight 
  7.  
  8.     Do Until M.qBW.EOF = True 
  9.         ii = ii + 2 
  10.         xlWksht.Cells(ii, 1).Value = M.qBW![Req No] 
  11.         xlWksht.Cells(ii, 2).Value = M.qBW![Description] 
  12.         xlWksht.Cells(ii, 3).Value = "" 
  13.         xlWksht.Cells(ii, 4).Value = M.qBW![ClientName] & Chr(10) & M.qBW![Status] 
  14.         xlWksht.Cells(ii, 5).Value = M.qBW![P L] & Chr(10) & M.qBW![TotalProg1Hrs] 
  15.  
  16.         SrchCriteria = "[Name]= " & "'" & M.qBW![Personnel2] & "'" 
  17.         rsinPers.FindFirst SrchCriteria 
  18.         If rsinPers.NoMatch = False Then 
  19.             xlWksht.Cells(ii, 6).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg2Hrs] 
  20.         End If 
  21.  
  22.         SrchCriteria = "[Name]= '" & M.qBW![Personnel3] & "'" 
  23.         rsinPers.FindFirst SrchCriteria 
  24.         If rsinPers.NoMatch = False Then 
  25.             xlWksht.Cells(ii, 7).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg3Hrs] 
  26.         End If 
  27.  
  28.         SrchCriteria = "[Name]= '" & M.qBW![Personnel4] & "'" 
  29.         rsinPers.FindFirst SrchCriteria 
  30.         If rsinPers.NoMatch = False Then 
  31.             xlWksht.Cells(ii, 8).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg4Hrs] 
  32.         End If 
  33.  
  34.         SrchCriteria = "[Name]= '" & M.qBW![Personnel5] & "'" 
  35.         rsinPers.FindFirst SrchCriteria 
  36.         If rsinPers.NoMatch = False Then 
  37.             xlWksht.Cells(ii, 9).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg5Hrs] 
  38.         End If 
  39.  
  40.         SrchCriteria = "[Name]= '" & M.qBW![Personnel6] & "'" 
  41.         rsinPers.FindFirst SrchCriteria 
  42.         If rsinPers.NoMatch = False Then 
  43.             xlWksht.Cells(ii, 10).Value = rsinPers![Initials] & Chr(10) & M.qBW![TotalProg6Hrs] 
  44.         End If 
  45.  
  46.         xlWksht.Cells(ii, 11).Value = "-" & Chr(10) & M.qBW.Fields("Per Hrs") 
  47.         xlWksht.Cells(ii, 12).Value = M.qBW.Fields("EstimatedTotalHours") & Chr(10) & M.qBW.Fields("Tot Hrs") 
  48.         xlWksht.Cells(ii, 13).Value = M.qBW![Start  Date] & Chr(10) & M.qBW![Start Date] 
  49.         xlWksht.Cells(ii, 14).Value = M.qBW![End Date] & Chr(10) & M.qBW![End  Date] 
  50.  
  51.         If M.qBW![Comments] = "" Or IsNull(M.qBW![Comments]) Then 
  52.             mystr = "Comments:" & Chr(10) & "NO COMMENTS FOR THIS RECORD!" 
  53.         Else 
  54.             mystr = "Comments:" & "'" & xlApp.Clean(Trim(M.qBW![Comments])) 
  55.         End If 
  56.  
  57.         Do 
  58.             Pos = InStr(Pos + 1, mystr, ":") 
  59.             If Not Pos = 0 Then 
  60.                 If Mid(mystr, Pos - 5, 1) = "/" Then 
  61.                     mystr = Left(mystr, Pos - 11) & Chr(10) & Mid(mystr, Pos - 10, 10) & Chr(10) & Mid(mystr, Pos + 1) 
  62.                     Pos = Pos + 2 
  63.                 End If 
  64.             End If 
  65.          Loop While Not Pos = 0 
  66.  
  67.  
  68.         xlWksht.Cells(ii + 1, 1).Value = "Comments:" 
  69.         xlWksht.Cells(ii + 1, 2).Value = Mid(mystr, 11) 
  70.  
  71.         With xlWksht.Range(xlWksht.Cells(ii + 1, 2), xlWksht.Cells(ii + 1, 14)) 
  72.             .HorizontalAlignment = xlLeft 
  73.             .VerticalAlignment = xlTop 
  74.             .WrapText = True 
  75.             .Orientation = 0 
  76.             .MergeCells = True 
  77.             .RowHeight = .Font.Size * (Len(xlWksht.Range("A" & ii + 2).text) - Len("Comments:")) / w + rht + (rht - .Font.Size) ' + newlinecnt * .Font.Size
  78.         End With 
  79.  
  80.         xlWksht.Columns("A:A").ColumnWidth = 9.15 
  81.  
  82.          'Draw Underline after each record:
  83.          '---------------------------------
  84.         TStr = "A" & CStr(ii + 1) & ":N" & CStr(ii + 1) 
  85.         xlWksht.Range(TStr).Select 
  86.         If Not IsEmpty(Selection.Range("A1")) Then 'check if first cell is empty
  87.             With xlWksht.Range(TStr).Borders(xlEdgeBottom) 
  88.                 .LineStyle = xlDouble 
  89.                 .Weight = xlThin 
  90.                 .ColorIndex = xlAutomatic 
  91.             End With 
  92.         End If 
  93.         M.qBW.MoveNext 
  94.     Loop 
  95.  
  96.     xlWksht.PageSetup.LeftFooter = " Legend:" & Chr(10) & "See Estimated Actual Tot.Hrs. Column: Top Number = Estimated Hrs. and Bottom Number = Actual Hrs." & Chr(10) & "See Estimated Actual Start/End Dates Columns: Top dates = Estimated Start/End dates and Bottom dates = Actual Start/End dates" 
  97.  
  98.  
  99.     strAnswer =  MsgBox("Would you like to Print this spreadsheet?", vbYesNo, "Print Option") 
  100.  
  101.     If strAnswer = vbYes Then 
  102.         Goto PrintSpreadsheet 
  103.     Else 
  104.         Goto ViewSpreadsheet 
  105.     End If 
  106.  
  107. PrintSpreadsheet: 
  108.      'Set up Print area:
  109.      '-----------------
  110.     xlWksht.PageSetup.PrintArea = xlWksht.Range("A1:" & xlWksht.Cells.SpecialCells(xlCellTypeLastCell).Address) 
  111.  
  112.     xlApp.ActiveWorkbook.Save 
  113.  
  114.     xlApp.Visible = True 
  115.     xlApp.UserControl = True 
  116.  
  117.     Goto CloseAllObjects 
  118.  
Thanks.
GiftX.
Sep 26 '07 #1
Share this question for a faster answer!
Share on Google+

Post your reply

Sign in to post your reply or Sign up for a free account.