08-15-2013, 09:04 AM
|
#1
|
Newly Registered User
Join Date: Aug 2013
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
|
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
|
|
|
08-26-2013, 09:04 PM
|
#2
|
AWF VIP
Join Date: Jun 2011
Location: Ohio, USA
Posts: 5,276
Thanks: 20
Thanked 873 Times in 858 Posts
|
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.
|
|
|
11-27-2018, 11:37 AM
|
#3
|
Newly Registered User
Join Date: Nov 2018
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
|
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.
|
|
|
12-07-2018, 04:31 AM
|
#4
|
Newly Registered User
Join Date: Dec 2018
Posts: 19
Thanks: 6
Thanked 3 Times in 3 Posts
|
Re: Export with formatting output file path access 2010
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
Last edited by Eugene-LS; 12-07-2018 at 04:38 AM.
|
|
|
Thread Tools |
|
Display Modes |
Rate This Thread |
Linear Mode
|
|
All times are GMT -8. The time now is 06:24 PM.
|
|