Solved

Formatting Excel Spreadsheet from Access

Posted on 2011-09-26
3
321 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)
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 47

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

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

747 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now