Transfer Report Results to an Excel Workbook (1 Viewer)

[BamaColtsFan]

Ok, so I need to get a results set from my Access application to an Excel Workbook. Normally, I would use a DoCmd.TransferSpreadsheet on a query result but in this case, I need certain formatting that I can only get via a report in Access. The code below is what I put together so far but it obviously doesn't work. With that said, how does one send the content of an Access Report to Excel?

DoCmd.TransferSpreadsheet acExport, 8, "rptDeptCompList3", strPath, True, "Compliance Summary"

 

[boblarson]

I need certain formatting that I can only get via a report in Access.

What kind of formatting? As far as I know, the only GOOD way to retain formatting from a report is to send to PDF. Any other export is touchy at best.

 

[BamaColtsFan]

Mostly, I need groups and totals. Using the pure query results then doing the formatting in Excel causes an error the next time I export the data (it doesn't like it when I insert lines in the results). The purpose of the data is to show compliance totals at different levels of the organization. Each department belongs to a Group and I need totals by group....

 

[boblarson]

Mostly, I need groups and totals. Using the pure query results then doing the formatting in Excel causes an error the next time I export the data (it doesn't like it when I insert lines in the results). The purpose of the data is to show compliance totals at different levels of the organization. Each department belongs to a Group and I need totals by group....

I hate to tell you this, but it is a very high pain in the @$$ to get this. I had to do it with an application we were building for NIKE and we wound up doing some major Excel coding to get the totals there.

One of the guys that worked with us as a contractor had also created a process by which he had the query for the groups and then had a separate query for the totals by group and then did a union query to bring it together.

I don't know that I can put together anything more to be able to illustrate as it is not simple stuff.

 

[alktrigger]

This is somewhat long and tedious, but you can format excel from access. Here is my code for exporting my reports.

Function fcnExportReport()

Dim strWorksheet As String
    Dim strWorksheetPath As String
    Dim appExcel As Excel.Application
    Dim sht As Excel.Worksheet
    Dim wkb As Excel.Workbook
    Dim rng As Excel.Range
    Dim strTable As String
    Dim strRange As String
    Dim strSaveName As String
    Dim strPrompt As String
    Dim strTitle As String
    Dim strDefault As String
    Dim intRecordNumber As Integer
    Dim dteInitialDate(8) As String
    Dim strChar(25) As String

    intRecordNumber = DCount("*", "[tblRepIPAR]") + 2 'the next number cell after the last transfered record

    dteInitialDate(0) = [Forms]![frmReport].txtStartDate
    


    
'Open the newly created worksheet and insert title material:
    Set appExcel = GetObject(, "Excel.Application")
    appExcel.Workbooks.Open (strSaveName)
    Set wkb = appExcel.ActiveWorkbook
    Set sht = appExcel.ActiveSheet
    sht.Activate
    
    With sht
    'Remove the "ID" column
        .Columns("A:A").Delete Shift:=xlToLeft
        .Columns("P:P").Delete Shift:=xlToLeft
        
    'convert negative numbers into "n/a"
        For n = 3 To 11
            For m = 2 To (intRecordNumber - 1)
                If .Range((strChar(n) & m)).Formula < 0 Then
                    .Range((strChar(n) & m)).Formula = "n/a"
                End If
            Next
        Next
        
    'Format the C column
        'Range("C2":"C" & (intRecordNumber - 1)).
        For m = 2 To (intRecordNumber - 1)
            strCell1 = .Range((strChar(2) & m)).Formula
            strCell2 = Left(strCell1, 1) & "." & mid(strCell1, 2, 1) & "." & Right(strCell1, 1)
            .Range((strChar(2) & m)).Formula = strCell2
        Next
        
    'Add the total calculations and count
        .Range(strChar(0) & intRecordNumber).Formula = "Total Sent"
        .Range(strChar(0) & (intRecordNumber + 1)).Formula = "Total Sending "
             For o = 3 To 11
                
                strFormula1 = "= SUM(" & strChar(o) & "2:" & strChar(o) & (intRecordNumber - 1) & ")"
                strFormula2 = "= COUNTIF(" & strChar(o) & "2:" & strChar(o) & (intRecordNumber - 1) & ", " & Chr(34) & "> 0" & Chr(34) & ")"
                strCell1 = strChar(o) & intRecordNumber
                strCell2 = strChar(o) & (intRecordNumber + 1)
                .Range(strCell1).Formula = strFormula1
                .Range(strCell2).Formula = strFormula2
                
             Next

            
'''''''''''''''''''''''''formatting''''''''''''''''''''''''''
    'Apply the Arial 10 pt font to the entire worksheet:
        .Range("A:O").Font.Name = "Arial"
        .Range("A:O").Font.Size = 10
        .PageSetup.Orientation = xlLandscape
        
        
    'change column Widths
        .Range("A:A").ColumnWidth = 45
        .Range("B:B").ColumnWidth = 10
        .Range("C:C").ColumnWidth = 10
        .Range("D:L").ColumnWidth = 4
        .Range("M:M").ColumnWidth = 14
        .Range("N:N").ColumnWidth = 93
        .Range("O:O").ColumnWidth = 14
        
    'format the column headings
        With .Range("A1:O1")
            .Font.Bold = True
        End With
        .Range("D1:L1").Orientation = xlUpward
        .Range("D1:L1").NumberFormat = "[$-409]d-mmm-yy;@"
        .Range("A1:O1").HorizontalAlignment = xlCenter
        .Range("A1").Formula = "Ships Configured for DS"
        .Range("A1:P1").RowHeight = 55
        
    'center B thru M.
        .Range("B:M").HorizontalAlignment = xlCenter
    
        'change week titles
        .Range("D1").Formula = dteInitialDate(0)
        .Range("E1").Formula = dteInitialDate(1)
        .Range("F1").Formula = dteInitialDate(2)
        .Range("G1").Formula = dteInitialDate(3)
        .Range("H1").Formula = dteInitialDate(4)
        .Range("I1").Formula = dteInitialDate(5)
        .Range("J1").Formula = dteInitialDate(6)
        .Range("K1").Formula = dteInitialDate(7)
        .Range("L1").Formula = dteInitialDate(8)
        .Range("N1").Formula = "Known Issues"
        

        'put borders around the main data
        strCell1 = strChar(14) & (intRecordNumber - 1)
           With .Range("A1:" & strCell1).Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = 1
           End With
           
         'put borders around the summary lines
         strCell1 = strChar(3) & intRecordNumber
         strCell2 = strChar(11) & (intRecordNumber + 1)
          With .Range(strCell1 & ":" & strCell2)
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
                .Borders.ColorIndex = 1
                .Font.Bold = True
           End With
        
         'put borders around the data calculations
         strCell1 = strChar(0) & (intRecordNumber)
         strCell2 = strChar(2) & (intRecordNumber + 8)
           With .Range(strCell1 & ":" & strCell2)
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
                .Borders.ColorIndex = 1
                .Font.Bold = True
                .Font.Color = -65536
           End With
           
           .Range("D" & intRecordNumber & ":L" & intRecordNumber).Font.Color = -6750208
           .Range("D" & intRecordNumber + 1 & ":L" & intRecordNumber + 1).Font.Color = -65281
           .Range("A" & intRecordNumber + 7 & ":C" & intRecordNumber + 8).Font.Color = -16777088       

         'conditional Formatting
        '''''''''''GREEN
            .Range("D2:L" & intRecordNumber - 1).FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
                Formula1:="=1", Formula2:="=8"
            .Range("D2:L" & intRecordNumber - 1).FormatConditions(.Range("D2:L" & intRecordNumber - 1).FormatConditions.Count).SetFirstPriority
            
            With .Range("D2:L" & intRecordNumber - 1).FormatConditions(1).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65280
                .TintAndShade = 0
                .PatternTintAndShade = 0
  
            End With
            .Range("D2:L" & intRecordNumber - 1).FormatConditions(1).StopIfTrue = True
            
        '''''''''''''RED
            .Range("D2:L" & intRecordNumber - 1).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
                Formula1:="=0"
            .Range("D2:L" & intRecordNumber - 1).FormatConditions(.Range("D2:L" & intRecordNumber - 1).FormatConditions.Count).SetFirstPriority
            
            With .Range("D2:L" & intRecordNumber - 1).FormatConditions(1).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 255
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            .Range("D2:L" & intRecordNumber - 1).FormatConditions(1).StopIfTrue = True
            
        ''''''''''''ORANGE
            .Range("D2:L" & intRecordNumber - 1).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
                Formula1:="= ""n/a"""
            .Range("D2:L" & intRecordNumber - 1).FormatConditions(.Range("D2:L" & intRecordNumber - 1).FormatConditions.Count).SetFirstPriority
            
            With .Range("D2:L" & intRecordNumber - 1).FormatConditions(1).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            .Range("D2:L" & intRecordNumber - 1).FormatConditions(1).StopIfTrue = True



    
    End With
    
    
ErrorHandlerExit:
    Exit Function
    
    
ErrorHandler:
    If Err = 429 Then
        'Excel is not running; open Excel with CreateObject:
           Set appExcel = CreateObject("Excel.Application")
           Resume Next
        Else
            MsgBox "Error No: " & Err.Number _
            & "; Description: " & Err.Description
        Resume ErrorHandlerExit
    End If

End Function

 

[BamaColtsFan]

I hate to tell you this, but it is a very high pain in the @$$ to get this. I had to do it with an application we were building for NIKE and we wound up doing some major Excel coding to get the totals there.

One of the guys that worked with us as a contractor had also created a process by which he had the query for the groups and then had a separate query for the totals by group and then did a union query to bring it together.

I don't know that I can put together anything more to be able to illustrate as it is not simple stuff.

Ok, so doing the union trick was pretty simple... The only problem I have at this point is that to get the totals, I leave the department null in the portion that does the totals. In the union, the sort order places that now null value at the top of the results rather than below for the given group. Might you know an easy way to sort a null to the bottom of an ascending list?

 

[boblarson]

Ok, so doing the union trick was pretty simple... The only problem I have at this point is that to get the totals, I leave the department null in the portion that does the totals. In the union, the sort order places that now null value at the top of the results rather than below for the given group. Might you know an easy way to sort a null to the bottom of an ascending list?

Create an "ID" field in the totals and set it to 999999 and it should go to the bottom.

 

[BamaColtsFan]

Well, they went to the bottom... All the Group totals... They don't stay with their groups when I do it that way...

 

[boblarson]

Well, they went to the bottom... All the Group totals... They don't stay with their groups when I do it that way...

It has been quite sometime since I dealt with it. I may have to look again to see how he did it. I don't quite remember, unless he had included the group name in the totals query.

 

[BamaColtsFan]

I did include the group name in the totals query... I've tried a couple of different ways to sort the result but it keeps comming out the same... I may have to just live with the sort order...

 

[boblarson]

I did include the group name in the totals query... I've tried a couple of different ways to sort the result but it keeps comming out the same... I may have to just live with the sort order...

I will try to double check when I get home. Or, if you want to upload a copy of the db we can try working on it now.

 

[BamaColtsFan]

I will try to double check when I get home. Or, if you want to upload a copy of the db we can try working on it now.

Ok... I finally got it to work... I had the ID field in the wrong place. It needed to be between the group and department fields. Works great now! Thanks!!

 

[boblarson]

Ok... I finally got it to work... I had the ID field in the wrong place. It needed to be between the group and department fields. Works great now! Thanks!!

Cool, glad you got it sorted.