Go Back   Access World Forums > Microsoft Access Discussion > Macros

 
Reply
 
Thread Tools Rating: Thread Rating: 5 votes, 5.00 average. Display Modes
Old 08-15-2013, 09:04 AM   #1
tirrells
Newly Registered User
 
Join Date: Aug 2013
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
tirrells is on a distinguished road
Export with formatting output file path access 2010

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

tirrells is offline   Reply With Quote
Old 08-26-2013, 09:04 PM   #2
GinaWhipp
AWF VIP
 
GinaWhipp's Avatar
 
Join Date: Jun 2011
Location: Ohio, USA
Posts: 5,247
Thanks: 20
Thanked 869 Times in 854 Posts
GinaWhipp has a spectacular aura about GinaWhipp has a spectacular aura about
Re: Export with formatting output file path access 2010

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
__________________
Gina Whipp
Microsoft MVP (Access 2010-2015)


To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
GinaWhipp is offline   Reply With Quote
Old 11-27-2018, 11:37 AM   #3
Proffancypants
Newly Registered User
 
Join Date: Nov 2018
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Proffancypants is on a distinguished road
Re: Export with formatting output file path access 2010

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.

Proffancypants is offline   Reply With Quote
Old 12-07-2018, 04:31 AM   #4
Eugene-LS
Newly Registered User
 
Join Date: Dec 2018
Posts: 17
Thanks: 6
Thanked 2 Times in 2 Posts
Eugene-LS is on a distinguished road
Re: Export with formatting output file path access 2010

Quote:
Originally Posted by tirrells View Post
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


Last edited by Eugene-LS; 12-07-2018 at 04:38 AM.
Eugene-LS is offline   Reply With Quote
Reply

Tags
export with formatting

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Export as PDF with variable document name and file path name thisisanemergency Modules & VBA 9 10-26-2012 06:50 AM
Export XML File Error - Access 2010 delphinidae Reports 1 09-13-2012 03:48 AM
Formatting path name for PDF output Sketchin Modules & VBA 13 07-11-2012 11:50 AM
Output File to a different path cjinls Macros 1 03-04-2011 11:24 PM
Output To File path GohDiamond Macros 2 12-30-2010 01:56 PM




All times are GMT -8. The time now is 07:09 PM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post


Sponsored Links


Powered by vBulletin®
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World