Solved

Formatting Excel Spreadsheet from Access

Posted on 2011-09-26
3
328 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 (Access MVP)
[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 500 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 (Access MVP)
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

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

Question has a verified solution.

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

This article describes two methods for creating a combo box that can be used to add new items to the row source -- one for simple lookup tables, and one for a more complex row source where the new item needs data for several fields.
I was prompted to write this article after the recent World-Wide Ransomware outbreak. For years now, System Administrators around the world have used the excuse of "Waiting a Bit" before applying Security Patch Updates. This type of reasoning to me …
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

705 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