Export with formatting output file path access 2010

tirrells · 08-15-2013, 09:04 AM

Export with formatting output file path access 2010
I am using the export with formatting option and need a little help with what the full path would be to automatically export to a specific spreadsheet cell in excel.
I have
C:\\Pending_Waterfall\Booking_Report.xlsx\
Im not sure what goes next. The name of the spreadsheet is CQ and I always want the data to start in Cell A2 and B2.
Thanks for your help.
Sharon

GinaWhipp · 08-26-2013, 09:04 PM

Don't know about a Macro to get that done sounds like you're going to need Automation to do that, have a look at...

http://www.btabdevelopment.com/ts/tq2xlspecwspath

Proffancypants · 11-27-2018, 11:37 AM

Thank you for this. I know no one replied, but it actually really helped me figure out that is actually possible within the output file box. The office access documentation didn't seem to even elude to Expression Builder existing.

Eugene-LS · 12-07-2018, 04:31 AM

Quote:

Originally Posted by tirrells

Export with formatting output file path access 2010
I am using the export with formatting option and need a little help with what the full path would be to automatically export to a specific spreadsheet cell in excel.
I have
C:\\Pending_Waterfall\Booking_Report.xlsx\
Im not sure what goes next. The name of the spreadsheet is CQ and I always want the data to start in Cell A2 and B2.
Thanks for your help.
Sharon

Code:

Private Sub test001()
'just to test the procedure below
    MakeReporIntExcel "D:\Temp\"
End Sub

Public Sub MakeReporIntExcel(sExportFolder$)
'
Dim objExcelApp As Object
Dim WrkBk As Object, rngActive As Object, rngInput As Object

Dim objActiveSheet As Object ' ...
Dim iListNo% 'List NO
Dim iRowNo%
Dim sBaseQueryName As String
Dim v As Variant, s$, sTemp$, sUsluga$, sUslugaName$
Dim i%, x%
'
'--------------------------------------------------------------------------

On Error GoTo MakeReporIntExcel_Err

    DoCmd.Hourglass True '

MakeReporIntExcel_StartNewList:
    If iListNo = 0 Then
            iListNo = 1
            Set objExcelApp = CreateObject("Excel.Application")
            'objExcelApp.Visible = True
            'Create new WorkBook
            Set WrkBk = objExcelApp.WorkBooks.Add
    End If
    
'Link to active List
    Set objActiveSheet = WrkBk.Sheets(iListNo)
    
'Name List
    objActiveSheet.Name = "My list Name " & iListNo

'First string
    'Link to sell А2 and set focus to it.
    Set rngActive = objActiveSheet.Cells(1, 2) 'First string  - second column
    
    
    rngActive = "Big HEADER"
    rngActive.Font.Size = 14
    rngActive.Font.Bold = True
        
    With objActiveSheet.Range(rngActive, rngActive.Offset(0, 4)) ' 5
    .Merge
    .HorizontalAlignment = -4108
    .VerticalAlignment = -4108 'xlVAlignCenter
    .RowHeight = .RowHeight * 2
    End With



'Second row
    'Link to cell 2:2 and ...
    Set rngActive = objActiveSheet.Cells(2, 2) 'second row  - second column
    
    
    
    rngActive = "Sub header ..."
    rngActive.Font.Size = 13
    rngActive.Font.Bold = True
        
    With objActiveSheet.Range(rngActive, rngActive.Offset(0, 4)) ' 5
    .Merge
    .HorizontalAlignment = -4108 '-4108 'xlHAlignCenter
    .VerticalAlignment = -4108   'xlVAlignCenter
    .RowHeight = .RowHeight * 1.2
    End With


' Start with data
'--------------------------------------------------------------------------
' Headers
'--------------------------------------------------------------------------


    iRowNo = 3
    Set rngActive = objActiveSheet.Cells(iRowNo, 2) '3 row  - second column
    
    
    With rngActive
        .ColumnWidth = 30
        .Borders.LineStyle = 1 '-4108 'xlContinuous 'Line
        .HorizontalAlignment = -4108 'xlHAlignCenter
        .Interior.Color = RGB(220, 220, 220) 'Серый цвет
    End With

'3
    Set rngActive = objActiveSheet.Cells(iRowNo, 3) '
    rngActive = "Name 01"
    With rngActive
        .ColumnWidth = 20
        .Borders.LineStyle = 1 'xlContinuous
        .HorizontalAlignment = -4108 'xlHAlignCenter
        .Interior.Color = RGB(220, 220, 220) 'Gray color
    End With

'3 - Name af some thing 02
    Set rngActive = objActiveSheet.Cells(iRowNo, 4) 'третья строка  - второй столбец
    rngActive = "Name 02"
    
    With rngActive
        .ColumnWidth = 20
        .Borders.LineStyle = 1
        .HorizontalAlignment = -4108 'xlHAlignCenter
        .Interior.Color = RGB(220, 220, 220) 'Gray color
    End With

'4 - Name af some thing 03
    Set rngActive = objActiveSheet.Cells(iRowNo, 5)
    rngActive = "Name 03"
    
    With rngActive
        .ColumnWidth = 20
        .Borders.LineStyle = 1 'xlContinuous 'Line
        .HorizontalAlignment = -4108 'xlHAlignCenter
        .Interior.Color = RGB(220, 220, 220) 'Gray color
    End With

'5 - Total
    Set rngActive = objActiveSheet.Cells(iRowNo, 6)
    rngActive = "TOTAL"
    
    With rngActive
        .ColumnWidth = 20
        .Borders.LineStyle = 1 'xlContinuous 'Line
        .HorizontalAlignment = -4108 'xlHAlignCenter
        .Interior.Color = RGB(220, 220, 220) 'Gray color
    End With
'--------------------------------------------------------------------------
'END OF Header
'--------------------------------------------------------------------------
    
    iRowNo = 3
    For i = 1 To 4
        iRowNo = iRowNo + 1
        sUsluga = "Servise name " & Format(i, "000")  '
        sUslugaName = "SN: " & Format(i, "00")
        
        Set rngActive = objActiveSheet.Cells(iRowNo, 2) '
        rngActive = "Servise Q-ty " & sUslugaName
        rngActive.Borders.LineStyle = 1 'Line
        
        Set rngActive = objActiveSheet.Cells(iRowNo, 3) '
        rngActive.Borders.LineStyle = 1 'Line
        rngActive = CCur(i) 'For example
    
    '
        Set rngActive = objActiveSheet.Cells(iRowNo, 4) 'row - column
        rngActive.Borders.LineStyle = 1 'Line
        rngActive = CCur(i) 'For example
    
    '
        Set rngActive = objActiveSheet.Cells(iRowNo, 5) 'row - column
        rngActive.Borders.LineStyle = 1 'Line
        rngActive = CCur(i) 'For example
        
    'Total
        Set rngActive = objActiveSheet.Cells(iRowNo, 6) 'row - column
        rngActive.Borders.LineStyle = 1 'Line
        rngActive.FormulaR1C1 = "=RC[-3]+RC[-2]+RC[-1]"
        rngActive.Font.Bold = True
        
        '=============================================================
    'Total 2
        iRowNo = iRowNo + 1

        Set rngActive = objActiveSheet.Cells(iRowNo, 2) 'row - column
        rngActive = "Total of ... some thing ..." & sUslugaName
        With rngActive
            .Borders.LineStyle = 1 'Line
        End With
        '
        Set rngActive = objActiveSheet.Cells(iRowNo, 3) 'row - column
        rngActive.Borders.LineStyle = 1 'Line
        rngActive = CCur(i) 'For example
    
    '
        Set rngActive = objActiveSheet.Cells(iRowNo, 4) 'row - column
        rngActive.Borders.LineStyle = 1 'Line
        rngActive = CCur(i) 'For example
        
    '
        Set rngActive = objActiveSheet.Cells(iRowNo, 5) 'row - column
        rngActive.Borders.LineStyle = 1 'Line
        rngActive = CCur(i) 'For example
        
    'Total 3
        Set rngActive = objActiveSheet.Cells(iRowNo, 6) 'row - column
        rngActive.Borders.LineStyle = 1 'Line
        rngActive.FormulaR1C1 = "=RC[-3]+RC[-2]+RC[-1]"
        rngActive.Font.Bold = True
    Next i

'
    Set rngActive = objActiveSheet.Cells(iRowNo, 2) 'row - column
    With objActiveSheet.Range(rngActive, rngActive.Offset(0, 4)) ' 5
        .Borders(9).LineStyle = -4119 'xlEdgeBottom = 9 & Const xlDouble = -4119 (&HFFFFEFE9)
    End With
    
    
    iRowNo = iRowNo + 1 '- Fix
    Set rngActive = objActiveSheet.Cells(iRowNo, 2) 'строка - второй столбец
    With objActiveSheet.Range(rngActive, rngActive.Offset(0, 4)) ' 5
        .RowHeight = 7
    End With
'--------------------------------------------------------------------------
'Tariffs
'--------------------------------------------------------------------------
    
    For i = 1 To 4
        iRowNo = iRowNo + 1
        Select Case i
            Case 1
                sUsluga = "A18.05.002.001"   '
                sUslugaName = "N\D"
            Case 2
                sUsluga = "A18.05.011"       '
                sUslugaName = "N\D"
            Case 3
                sUsluga = "A18.30.001"       '
                sUslugaName = "N\D"
            Case 4
                sUsluga = "A18.30.001.002"   '
                sUslugaName = "N\D"
            End Select
        Set rngActive = objActiveSheet.Cells(iRowNo, 2) 'row - column
        
        rngActive = "Tariff " & sUslugaName
        rngActive.Borders.LineStyle = 1 'Line
        '
        
        Set rngActive = objActiveSheet.Cells(iRowNo, 3) 'row - column
        
        rngActive.Borders.LineStyle = 1 'Line
        'SELECT prPrice FROM dtPrices WHERE (((dtPrices.prSERVICE)="A18.05.002.001"));
        rngActive = CCur(i * 12) '"ot baldy" (Rus) = ("from the bulldozer")
        rngActive.NumberFormat = "#,##0.00 $" ' Format!
    Next i
'--------------------------------------------------------------------------
'Total 04
'--------------------------------------------------------------------------
    iRowNo = iRowNo + 1 '

    Set rngActive = objActiveSheet.Cells(iRowNo, 2)  'row - column
    With objActiveSheet.Range(rngActive, rngActive.Offset(0, 4)) ' 5
        .Borders(9).LineStyle = -4119 'xlEdgeBottom = 9 & Const xlDouble = -4119 (&HFFFFEFE9)
        .RowHeight = 7
    End With
    
    
    For i = 1 To 4
        iRowNo = iRowNo + 1
        Select Case i
            Case 1
                sUsluga = "A18.05.002.001"   '
                sUslugaName = "00" & " - " & Format(i, "00")
            Case 2
                sUsluga = "A18.05.011"       '
                sUslugaName = "00" & " - " & Format(i, "00")
            Case 3
                sUsluga = "A18.30.001"       '
                sUslugaName = "00" & " - " & Format(i, "00")
            Case 4
                sUsluga = "A18.30.001.002"   '
                sUslugaName = "00" & " - " & Format(i, "00")
        End Select

        Set rngActive = objActiveSheet.Cells(iRowNo, 2) 'row - column
        rngActive = "Total ... " & sUslugaName
        rngActive.Borders.LineStyle = 1 'Line
        
        '
        Set rngActive = objActiveSheet.Cells(iRowNo, 3) 'row - column
        rngActive.Borders.LineStyle = 1 'Line
        rngActive = CCur(i * 100)
        rngActive.NumberFormat = "#,##0.00 $" ' Cell format
    
        '
        Set rngActive = objActiveSheet.Cells(iRowNo, 4) 'row - column
        rngActive.Borders.LineStyle = 1 'Line
        rngActive = CCur(i * 100)
        rngActive.NumberFormat = "#,##0.00 $" ' Cell format
    
        '
        Set rngActive = objActiveSheet.Cells(iRowNo, 5) 'row - column
        
        rngActive.Borders.LineStyle = 1 'Line
        rngActive = CCur(i * 100)
        rngActive.NumberFormat = "#,##0.00 $" ' Cell format
        
        'TOTAL:
        Set rngActive = objActiveSheet.Cells(iRowNo, 6)
        
        rngActive = "=SUM(RC[-3]:RC[-1])"
        With rngActive
            .Borders.LineStyle = 1 'Line
            .Font.Bold = True
        End With
        
    Next i

'Line
    Set rngActive = objActiveSheet.Cells(iRowNo, 2) 'row - column
    With objActiveSheet.Range(rngActive, rngActive.Offset(0, 4)) ' 5
        .Borders(9).LineStyle = -4119 'xlEdgeBottom = 9 & Const xlDouble = -4119 (&HFFFFEFE9)
    End With

'
'======================================= TOTAL =======================================
   iRowNo = iRowNo + 1
   Set rngActive = objActiveSheet.Cells(iRowNo, 2) '
    
    rngActive = "Total all:"
    With rngActive
        .Borders.LineStyle = 1 'Line
        '.NumberFormat = "#,##0.00 $" ' Cell format
        .Font.Bold = True
        .Font.Color = -6737101
        .RowHeight = .RowHeight * 1.12
    End With

'
    Set rngActive = objActiveSheet.Cells(iRowNo, 3)
    
    rngActive = "=SUM(C" & iRowNo - 4 & ":C" & iRowNo - 1 & ")"
    With rngActive
        .Borders.LineStyle = 1 'Line
        .NumberFormat = "#,##0.00 $" ' Cell format
        .Font.Bold = True
        .Font.Color = -6737101
    End With

'
    Set rngActive = objActiveSheet.Cells(iRowNo, 4)
    
    rngActive = "=SUM(D" & iRowNo - 4 & ":D" & iRowNo - 1 & ")"
    With rngActive
        .Borders.LineStyle = 1 'Line
        .NumberFormat = "#,##0.00 $" ' Cell format
        .Font.Bold = True
        .Font.Color = -6737101
    End With

'SUM
    Set rngActive = objActiveSheet.Cells(iRowNo, 5)
    
    rngActive = "=SUM(E" & iRowNo - 4 & ":E" & iRowNo - 1 & ")"
    'rngActive = "=C16+C17+C18+C19"
    With rngActive
        .Borders.LineStyle = 1 'Line
        .NumberFormat = "#,##0.00 $" ' Cell format
        .Font.Bold = True
        .Font.Color = -6737101
    End With

'SUM
    Set rngActive = objActiveSheet.Cells(iRowNo, 6)
    
    rngActive = "=SUM(F" & iRowNo - 4 & ":F" & iRowNo - 1 & ")"
    'rngActive = "=C16+C17+C18+C19"
    With rngActive
        .Borders.LineStyle = 1 'Line
        .NumberFormat = "#,##0.00 $" ' Cell format
        .Font.Bold = True
        .Font.Color = -6737101
    End With




    If iListNo < 3 Then 'Next!
        iListNo = iListNo + 1
        GoTo MakeReporIntExcel_StartNewList
    End If

'!
    Set rngActive = objActiveSheet.Cells(1, 1) '
    objExcelApp.Visible = True

'Save file to HDD.
    sTemp = v & "Test000"
    'Excel Window = Maximized
    objExcelApp.WindowState = -4137 'xlMaximized

    s = sExportFolder & "Report " & sTemp & ".xls"
    objExcelApp.DisplayAlerts = False
    WrkBk.SaveAs s ', 18
    objExcelApp.Visible = True

MakeReporIntExcel_Bye:
    DoCmd.Hourglass False 'Normal Cursor! (Arrrow)
    On Error Resume Next
   
    Set WrkBk = Nothing
    Set objActiveSheet = Nothing
    Set rngActive = Nothing
    Set rngInput = Nothing
    Set objExcelApp = Nothing
    Exit Sub

MakeReporIntExcel_Err:
    MsgBox "Err " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "In SUB: MakeReporIntExcel", vbCritical, "Error in ..."
    Resume MakeReporIntExcel_Bye

End Sub