?
Solved

Formatting Excel Spreadsheet from Access

Posted on 2011-09-26
3
Medium Priority
?
330 Views
Last Modified: 2012-08-14
I'm building an Excel spreadsheet from data in an Access query.  The query returns a set of records where the rows are identified by the "Item" and "Title" fields, and the columns are identified by the "DateRange" and "Activity" fields, and the "LD_Name" and "LD_Num" fields are text fields which contain the values for the cells within the matrix.  There are records which contain NULL values in those fields, or there may be multiple records for a particular combination of row/column.  The loop that populates each of these cells works properly.
Private Sub cmd_Output_Click()

    Dim intCount As Integer
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim xl As Excel.Application
    Dim wbk As Excel.Workbook
    Dim sht As Excel.Worksheet
    Dim intRecCount As Integer
    
    Dim strItem As String
    Dim strDateRange As String
    Dim strActivity As String
    Dim intRow As Integer, intCol As Integer, intLoop As Integer
    
    On Error GoTo ProcError
    
    'Check to make sure at least on focus category item is selected
    intCount = DSum("IsSelected", "qry_frm_LD_Act_Matrix_sub_Focus_Category_Items")
    If intCount = 0 Then
        MsgBox "Select at least one Focus Category Item to include in the output"
        Exit Sub
    End If
    
    'Check to make sure that at least 1 activity is selected
    intCount = DSum("IsSelected", "qry_frm_LD_Act_Matrix_sub_Activities")
    If intCount = 0 Then
        MsgBox "Select at least one Focus Category Item to include in the output"
        Exit Sub
    End If
    
    'Open the recordset for output
    Set db = CurrentDb
    Set qdf = CurrentDb.QueryDefs("qry_frm_LD_Act_Matrix_Output")
    qdf.Parameters(0) = Me.cbo_Fiscal_Year
    Set rs = qdf.OpenRecordset
    If Not rs.EOF Then
        rs.MoveLast
        intRecCount = rs.RecordCount
        rs.MoveFirst
    End If
    qdf.Close
    Set qdf = Nothing
    
    'Open Excel and create a new workbook
    Set xl = CreateObject("excel.application")
    xl.Visible = True
    Set wbk = xl.Workbooks.Add
    Set sht = wbk.Sheets(1)
    
    'Loop through the recordset building the Excel spreadsheet
    intRow = 2
    Form_frm_Status.StatusUpdate message:="Building spreadsheet!"
    While Not rs.EOF
    
        DoEvents
        Form_frm_Status.StatusUpdate PctComplete:=rs.AbsolutePosition / intRecCount
        
        'for each record, check to see whether to shift to a new row for a new focus category Item
        If rs("Item") <> strItem Then
            intRow = intRow + 1
            strItem = rs("Item")
                        
            'If a new row, post the Row headings
            sht.Cells(intRow, 1) = rs("Item")
            sht.Cells(intRow, 2) = rs("Title")
            intCol = 2
        End If
            
        'For each record, check to see whether to shift to a new column
        If rs("DateRange") <> strDateRange Or rs("Activity") <> strActivity Then
            intCol = intCol + 1
            strDateRange = rs("DateRange")
            strActivity = rs("Activity")
            
            'Only need to worry about column headers for first row
            If intRow = 3 Then
                sht.Cells(1, intCol) = rs("Activity")
                sht.Cells(2, intCol) = rs("DateRange")
            End If
        End If
        
        sht.Cells(intRow, intCol).Activate
        If rs("ACT_LD_ID") <> "" Then
            sht.Cells(intRow, intCol) = sht.Cells(intRow, intCol) & "- " & rs("LD_Name") & " (" & rs("LD_Num") & ")" & vbCrLf
        End If
        
        rs.MoveNext
    Wend
    
    'Format the various rows and columns
'    Form_frm_Status.StatusUpdate "Formatting spreadsheet"
    sht.Rows(1).Select
    With Selection
        .Activate
        .WrapText = True
    End With
    sht.Rows(2).Select
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    sht.Columns(1).Select
    With Selection
        .ColumnWidth = 10
    End With
    sht.Columns(2).Select
    With Selection
        .ColumnWidth = 50
        .WrapText = True
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    sht.Range("C3").Select
    sht.Range("C3").Activate
    ActiveWindow.FreezePanes = True
    
    For intLoop = 3 To intCol
        sht.Columns(intLoop).Select
        With Selection
            .ColumnWidth = 50
            .WrapText = True
        End With
    Next
    
    For intLoop = 3 To intRow
        sht.Rows(intLoop).Select
        With Selection
            .VerticalAlignment = xlTop
        End With
    Next
        
ProcExit:
    If Not wbk Is Nothing Then Set wbk = Nothing
    If Not xl Is Nothing Then
        xl.Visible = True
        Set xl = Nothing
    End If
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Form_frm_Status.CloseForm
    MsgBox "Done!"
    
    Exit Sub
ProcError:
    If Err.Number = 91 Then
        Set wbk = xl.ActiveWorkbook
        Set sht = wbk.ActiveSheet
        Resume
    Else
        Debug.Print Err.Number, Err.Description
        MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, "cmd_Output_to_Excel"
        Resume ProcExit
    End If
    
End Sub

Open in new window


Following that loop, there is a series of statements, starting on line 94, which should format the spreadsheet, but which frequently raises an error (#462, The remote server machine does not exist of is unavailable) when it gets to line 95 (With Selection).  This generally occurs the 2nd and subsequent times I run the code after the form that contains the command button is opened.

What is interesting is that the first time the code is run, it generally runs to completion, with the following issues:
1.  the FreezePanes line (119) does not appear to work properly.  Although the left 2 columns are frozen in place, the top two rows are not.
2.  When I close the Excel application after it has completed the process, there is still a reference to the Excel object in the Task Manager processes tab.  When I close Excel after the process generates the #462 error, is generated, there is no Excel process still running.

So, my questions are:
1.  What am I doing wrong that is causing the #462 error to run
2.  Why isn't the FreezePanes method working the way I anticipate

I'm sure this has something to do with an explicit reference to an Excel object, but cannot figure out what I'm missing.
0
Comment
Question by:Dale Fye
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
3 Comments
 
LVL 20

Expert Comment

by:clarkscott
ID: 36599125
sht.Worksheets(YourSheetName).Cells(Row, Column).NumberFormat = "###.0"

Scott C
0
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 2000 total points
ID: 36599130
You have lots of unqualified references to selection, which is the cause of your first problem. Try this (after restarting your machine to clear rogue instance of Excel):
Private Sub cmd_Output_Click()

    Dim intCount As Integer
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim xl As Excel.Application
    Dim wbk As Excel.Workbook
    Dim sht As Excel.Worksheet
    Dim intRecCount As Integer
    
    Dim strItem As String
    Dim strDateRange As String
    Dim strActivity As String
    Dim intRow As Integer, intCol As Integer, intLoop As Integer
    
    On Error GoTo ProcError
    
    'Check to make sure at least on focus category item is selected
    intCount = DSum("IsSelected", "qry_frm_LD_Act_Matrix_sub_Focus_Category_Items")
    If intCount = 0 Then
        MsgBox "Select at least one Focus Category Item to include in the output"
        Exit Sub
    End If
    
    'Check to make sure that at least 1 activity is selected
    intCount = DSum("IsSelected", "qry_frm_LD_Act_Matrix_sub_Activities")
    If intCount = 0 Then
        MsgBox "Select at least one Focus Category Item to include in the output"
        Exit Sub
    End If
    
    'Open the recordset for output
    Set db = CurrentDb
    Set qdf = CurrentDb.QueryDefs("qry_frm_LD_Act_Matrix_Output")
    qdf.Parameters(0) = Me.cbo_Fiscal_Year
    Set rs = qdf.OpenRecordset
    If Not rs.EOF Then
        rs.MoveLast
        intRecCount = rs.RecordCount
        rs.MoveFirst
    End If
    qdf.Close
    Set qdf = Nothing
    
    'Open Excel and create a new workbook
    Set xl = CreateObject("excel.application")
    xl.Visible = True
    Set wbk = xl.Workbooks.Add
    Set sht = wbk.Sheets(1)
    
    'Loop through the recordset building the Excel spreadsheet
    intRow = 2
    Form_frm_Status.StatusUpdate Message:="Building spreadsheet!"
    While Not rs.EOF
    
        DoEvents
        Form_frm_Status.StatusUpdate PctComplete:=rs.AbsolutePosition / intRecCount
        
        'for each record, check to see whether to shift to a new row for a new focus category Item
        If rs("Item") <> strItem Then
            intRow = intRow + 1
            strItem = rs("Item")
                        
            'If a new row, post the Row headings
            sht.Cells(intRow, 1) = rs("Item")
            sht.Cells(intRow, 2) = rs("Title")
            intCol = 2
        End If
            
        'For each record, check to see whether to shift to a new column
        If rs("DateRange") <> strDateRange Or rs("Activity") <> strActivity Then
            intCol = intCol + 1
            strDateRange = rs("DateRange")
            strActivity = rs("Activity")
            
            'Only need to worry about column headers for first row
            If intRow = 3 Then
                sht.Cells(1, intCol) = rs("Activity")
                sht.Cells(2, intCol) = rs("DateRange")
            End If
        End If
        
        sht.Cells(intRow, intCol).Activate
        If rs("ACT_LD_ID") <> "" Then
            sht.Cells(intRow, intCol) = sht.Cells(intRow, intCol) & "- " & rs("LD_Name") & " (" & rs("LD_Num") & ")" & vbCrLf
        End If
        
        rs.MoveNext
    Wend
    
    'Format the various rows and columns
'    Form_frm_Status.StatusUpdate "Formatting spreadsheet"
      sht.Rows(1).WrapText = True
    With sht.Rows(2).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    sht.Columns(1).ColumnWidth = 10
    With sht.Columns(2)
        .ColumnWidth = 50
        .WrapText = True
      With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
      End With
    End With
    sht.Range("C3").Select
    xlapp.ActiveWindow.FreezePanes = True
    
    For intLoop = 3 To intCol
        With sht.Columns(intLoop)
            .ColumnWidth = 50
            .WrapText = True
        End With
    Next
    
    For intLoop = 3 To intRow
         sht.Rows(intLoop).VerticalAlignment = xlTop
    Next
        
ProcExit:
    If Not wbk Is Nothing Then Set wbk = Nothing
    If Not xl Is Nothing Then
        xl.Visible = True
        Set xl = Nothing
    End If
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    Form_frm_Status.CloseForm
    MsgBox "Done!"
    
    Exit Sub
ProcError:
    If Err.Number = 91 Then
        Set wbk = xl.ActiveWorkbook
        Set sht = wbk.ActiveSheet
        Resume
    Else
        Debug.Print Err.Number, Err.Description
        MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, "cmd_Output_to_Excel"
        Resume ProcExit
    End If
    
End Sub

Open in new window

0
 
LVL 48

Author Closing Comment

by:Dale Fye
ID: 36599286
rorya,

Thanks.  That solved the error message and the rogue Excel issue.  That's what I get for pretty much copying a macro I created in excel using the Record Macro functionality.

The FreezePanes line is still not working properly.  But I think that ought to be another question, so I'll post it seperately.
0

Featured Post

Office 365 Training for IT Pros

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

My attempt to use PowerShell and other great resources found online to simplify the deployment of Office 365 ProPlus client components to any workstation that needs it, regardless of existing Office components that may be needing attention.
Traditionally, the method to display pictures in Access forms and reports is to first download them from URLs to a folder, record the path in a table and then let the form or report pull the pictures from that folder. But why not let Windows retr…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question