User Name Password Register
DaniWeb IT Discussion Community
Home
Forums
Tutorials
Code Snippets
Blogs
Link Directory
All
•
•
•
•
What is DaniWeb IT Discussion Community?
You're currently browsing the Visual Basic 4 / 5 / 6 section within the Software Development category of DaniWeb, a massive community of 456,496 software developers, web developers, Internet marketers, and tech gurus who are all enthusiastic about making contacts, networking, and learning from each other. In fact, there are 2,695 IT professionals currently interacting right now! Registration is free, only takes a minute and lets you enjoy all of the interactive features of the site.
Join our community!
Please support our Visual Basic 4 / 5 / 6 advertiser: Programming Forums
Views: 842 | Replies: 0
Reply
•
•
Join Date: Jul 2007
Posts: 113
Reputation: tgifgemini is an unknown quantity at this point 
Rep Power: 2
Solved Threads: 0
tgifgemini tgifgemini is offline Offline
Junior Poster

VB6 - Spreadsheet generates blank pages with no records.

  #1  
Sep 20th, 2007
VB6 - Spreadsheet generates blank pages with no records.
Good morning everyone.
I'm sure everybody is now familiar with my non-stop posting with my spreadsheet issues. I am populating a spreadsheet/report using vb. I am using a query/table as my input files. The problem is even if program executes and processes only one record, when I go to the spreadsheet "PrintPreview", I see stuff like "Page 1 of 22". Why is it generating all these pages while it only processed one record? Also, some times it prints blank pages.
Can anyone tell me how I can fix this? Module#1:

Help with Code Tags 
Set rsin = M.DB.OpenRecordset("qBiWeeklyPeriodCombined", dbOpenDynaset)
    Set rsSrtSelStr = M.DB.OpenRecordset("TblSelectionString", dbOpenDynaset)
     
    If rsin.RecordCount <= 0 Then
       MsgBox "There are no records for your selection String/Criteria", vbInformation, "PTS System"
       Exit Function
    End If
     
    Set xlApp = CreateObject("Excel.Application")
    Set xlWbk = xlApp.Workbooks.Open("C:\BiWeeklyPeriod.xls")
    Set xlWksht = xlWbk.Worksheets(1)
    
    xlWksht.UsedRange.ClearContents
    
    xlWksht.Cells(2, 1).Value = rsSrtSelStr![SelectionString]
    xlWksht.Cells(3, 1).Value = rsSrtSelStr![SortString]
    
    xlWksht.Range("A2:K2").MergeCells = True
    xlWksht.Range("A3:K3").MergeCells = True
      
    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 = Chr(10) & "PL" & Chr(10) & "Pgr"
    xlWksht.Cells(ii, 4).Value = Chr(10) & "Client Name" & Chr(10) & "& Status"
    xlWksht.Cells(ii, 5).Value = Chr(10) & "Current" & Chr(10) & "Hours"
    xlWksht.Cells(ii, 6).Value = "Estimated" & Chr(10) & "Actual" & Chr(10) & "Tot Hrs"
    xlWksht.Cells(ii, 7).Value = "Estimated" & Chr(10) & "Actual" & Chr(10) & "Start Date"
    xlWksht.Cells(ii, 8).Value = "Estimated" & Chr(10) & "Actual" & Chr(10) & "End Date"

    xlWksht.Range("A5:H5").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
    
    ii = 5
     w = 0
    For Each R In xlWksht.Range("A8:h8"): w = w + R.ColumnWidth: Next
    
    rht = xlWksht.Range("A6").RowHeight
    
    If rht > 409 Then
       rht = 409
    Else
       rht = xlWksht.Range("A6").RowHeight
    End If
    
    Do Until rsin.EOF = True
       ii = ii + 2
       xlWksht.Cells(ii, 1).Value = rsin![Req No]
       xlWksht.Cells(ii, 2).Value = rsin![Description]
       xlWksht.Cells(ii, 3).Value = rsin![P L] & Chr(10) & rsin![Pgmr2] & Chr(10) & rsin![Pgmr3]
       xlWksht.Cells(ii, 4).Value = rsin![ClientName] & Chr(10) & rsin![Status]
       xlWksht.Cells(ii, 5).Value = "-" & Chr(10) & rsin![Per Hrs]
       xlWksht.Cells(ii, 6).Value = rsin![Hours] & Chr(10) & rsin![Tot Hrs]
       xlWksht.Cells(ii, 7).Value = rsin![Start Date] & Chr(10) & rsin![Start Date]
       xlWksht.Cells(ii, 8).Value = rsin![End Date] & Chr(10) & rsin![End Date]
       'xlWksht.Cells(ii + 1, 1).Value = "Comments:" & Chr(10) & "'" & xlApp.Clean(Trim(rsin![Comments]))
          
        If rsin![Comments] = "" Or IsNull(rsin![Comments]) Then
           mystr = "Comments:" & Chr(10) & "NO COMMENTS FOR THIS RECORD!"
        Else
           mystr = "Comments:" & "'" & xlApp.Clean(Trim(rsin![Comments]))
        End If
        
        'New Logic 9/19/2007
        If rsin.RecordCount > 0 And mystr > "" Then
    
        Do
            newlinecnt = 0
            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)
                   newlinecnt = newlinecnt + 2
                   Pos = Pos + 2
               End If
            End If
        Loop While Not Pos = 0
         xlWksht.Cells(ii + 1, 1).Value = mystr
        'xlWksht.Cells(ii + 1, 1).Value = "Comments:" 'Left(mystr, 10)
        'xlWksht.Cells(ii + 1, 2).Value = Mid(mystr, 11)
          
        With xlWksht.Range(xlWksht.Cells(ii + 1, 1), xlWksht.Cells(ii + 1, 8))
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .WrapText = True
            .Orientation = 0
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlThin
            .IndentLevel = 0
            .MergeCells = True
            .RowHeight = .Font.Size * (Len(xlWksht.Range("A" & ii + 1).text) - Len("Comments:")) / w + rht + (rht - .Font.Size) ' + newlinecnt * .Font.Size
       End With
             xlWksht.Columns("A:A").ColumnWidth = 9.15
             xlWksht.Columns("B:B").ColumnWidth = 23
        End If
       
       rsin.MoveNext
       
    Loop
    
    xlWksht.PageSetup.LeftFooter = " Legend:" & Chr(10) & "See Tot Hrs. Column: Top Number = Estimated Hrs. and Bottom Number = Actual Hrs." & Chr(10) & "See Dates Columns: Top dates = Estimated Start/End dates and Bottom dates = Actual Start/End dates"
    
    'xlWksht.Range("A6").CopyFromRecordset rsin
    
    xlApp.ActiveWorkbook.Save
      
    MsgBox ("If you need to print this spreadsheet and because of Excel report limitations, You may need to go into the spreadsheet and Manually expand the rows to enable you see hidden data in some rows"), vbInformation, "ATTENTION!"
    xlApp.Visible = True
    xlApp.UserControl = True
    
    rsin.Close
    rsSrtSelStr.Close
    Set xlWbk = Nothing
    Set xlWksht = Nothing
    Set xlApp = Nothing
    M.DB.Close
    
    Exit Function


Module#2
Help with Code Tags 
Private Function BiWeeklyPeriodProgExportCriteria()
    'On Error GoTo Errorhandler
    Dim recordcnt As Long
    Dim SrchCriteria As String
    Dim P As Integer
    Dim R As Range
    Dim w As Long
    Dim rht As Long
    Dim TStr As String
    Dim Pos As Integer
    Dim mystr As String
    Dim newlinecnt As Integer
    
    'GX code2 begin here Modified 6/7/2007 1:00PM:
    '--------------------------------------------
    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
    
    If rht > 409 Then
       rht = 409
    Else
       rht = xlWksht.Range("A6").RowHeight
    End If
    
    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
        
        If mystr <> "" Then
        
        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 = mystr
        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              'Note: changed above from ("A" & ii + 1) to ("A" & ii + 2)
         
        xlWksht.Columns("A:A").ColumnWidth = 9.15
         
        TStr = "A" & CStr(ii + 1) & ":N" & CStr(ii + 1) ' Note: changed ":M" to ":N"
        xlWksht.Range(TStr).Select
           
        With Selection.Borders(xlEdgeBottom)
          .LineStyle = xlDouble
          .Weight = xlThin
          .ColorIndex = xlAutomatic
        End With
        End If
       
        M.qBW.MoveNext
    Loop
    
    'Adding an invisible comment to spreadsheet:
    '-------------------------------------------
    'xlWksht.Cells(ii + 3, 1).AddComment "Legend:" & "The last four columns to the right of this report, The top numbers and dates = Estimated hours, Estimated start/End dates, Bottom numbers and dates = Actual hours, Actual start/End dates"
    
    xlWksht.PageSetup.LeftFooter = " Legend:" & Chr(10) & "See Total Hrs. Column: Top Number = Estimated Hrs. and Bottom Number = Actual Hrs." & Chr(10) & "See Dates Columns: Top dates = Estimated Start/End dates and Bottom dates = Actual Start/End dates"
    
    'xlWksht.Range("A6").CopyFromRecordset M.qBW  'M.qBW
    
    xlApp.ActiveWorkbook.Save
    
    MsgBox ("If you need to print this spreadsheet and because of Excel report limitations, You may need to go into the spreadsheet and Manually expand the rows to enable you see hidden data in some rows"), vbInformation, "ATTENTION!"
    xlApp.Visible = True
    xlApp.UserControl = True
    
    rsinPers.Close
    M.qBW.Close
    rsSrtSelStr.Close
    Set xlWbk = Nothing
    Set xlWksht = Nothing
    Set xlApp = Nothing
    M.DB.Close
    
    Exit Function

Thanks.
tgif
AddThis Social Bookmark Button
Reply With Quote  
Reply

•
•
•
•

Only community members can participate in forum threads. You must register or log in to contribute.

Register
•
•
•
•
•
•
•
•
DaniWeb Visual Basic 4 / 5 / 6 Marketplace
•
•
•
•
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)

 

•
•
•
•
Thread Tools Display Modes
Linear Mode Linear Mode

•
•
•
•
google microsoft microsoft office spreadsheet
Similar Threads
Other Threads in the Visual Basic 4 / 5 / 6 Forum

Advertising Opportunities on DaniWeb
Contact Us - Newsletter Archive - Sitemap - Privacy Statement
All times are GMT -4. The time now is 3:25 am.
Forum system based on vBulletin Copyright ©2000 - 2008, Jelsoft Enterprises Ltd.
©2003 - 2008 DaniWeb® LLC