Formatting An Excel Spreadsheet on Export from Access 2000

J

JohnLee

Registered User.
Local time
Yesterday, 16:03
Joined
Mar 8, 2007
Messages
692
Good morning Folks,

I'm hoping someone can point me in the right direction. I have a query which I export to excel, now I've managed to get a certain amount of the formatting that I want done, but I've got to a point where I've become a bit stuck and I'm having difficulty in identifying how to complete the final bits of the formatting.

Below is my code so far:

Code: 
[FONT=Times New Roman][COLOR=blue]Function[/COLOR] ExportToExcel()[/FONT]
 
[FONT=Times New Roman]DoCmd.Echo [COLOR=blue]False[/COLOR], "Running Program"[/FONT]
[FONT=Times New Roman]DoCmd.Hourglass [COLOR=blue]True[/COLOR]     [/FONT]
[FONT=Times New Roman]DoCmd.SetWarnings [COLOR=blue]False[/COLOR] [/FONT]
 
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] ExcelFile [COLOR=blue]As String[/COLOR]  [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] ExcelWorksheet [COLOR=blue]As String[/COLOR] [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] Ques [COLOR=blue]As String[/COLOR] [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] QueryName [COLOR=blue]As String[/COLOR] [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] objDB [COLOR=blue]As[/COLOR] Database [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] MyDate [/FONT]
[FONT=Times New Roman][COLOR=blue]Dim[/COLOR] MyWeekDay [/FONT]
 
[FONT=Times New Roman]MyDate = Date  [/FONT]
[FONT=Times New Roman]MyWeekDay = Weekday(MyDate) [/FONT]
 
[FONT=Times New Roman][COLOR=blue]If[/COLOR] MyWeekDay = 6 [COLOR=blue]Then[/COLOR]                                                       [/FONT]
 
[FONT=Times New Roman]   ExcelFile = "H:\John Lee\StdDG" & "_" & Format(Date, "ddmmyy") & ".xls"  [/FONT]
[FONT=Times New Roman]   ExcelWorksheet = "StdDG " & Format(Date, "ddmmyy")                        [/FONT]
[FONT=Times New Roman]   Ques = "H:\John Lee\Questionnaires.mdb"                                    [/FONT]
[FONT=Times New Roman]   QueryName = "qryStandardD&GAnalysisTotals"                                [/FONT]
 
[FONT=Times New Roman]   [COLOR=blue]Set[/COLOR] objDB = OpenDatabase(Ques)                                          [/FONT]
 
[FONT=Times New Roman]   [COLOR=blue]If[/COLOR] Dir(ExcelFile) <> "" [COLOR=blue]Then[/COLOR] Kill ExcelFile                             [/FONT]
 
[FONT=Times New Roman]   objDB.Execute "Select*Into[Excel 8.0;Database=" & ExcelFile & "].[" & ExcelWorksheet & "] From " & "[" & QueryName & "]"[/FONT]
[FONT=Times New Roman]   objDB.Close                                                             [/FONT]
[FONT=Times New Roman]   [COLOR=blue]Set[/COLOR] objDB = [COLOR=blue]Nothing[/COLOR] [/FONT]
 
[FONT=Times New Roman]   [COLOR=blue]Dim[/COLOR] ObjExcel                                                            [/FONT]
[FONT=Times New Roman]   [COLOR=blue]Set[/COLOR] ObjExcel = CreateObject("Excel.Application")                        [/FONT]
[FONT=Times New Roman]   ObjExcel.Visible = [COLOR=blue]True[/COLOR] [/FONT]
 
[FONT=Times New Roman]   ObjExcel.Workbooks.Open "H:\John Lee\StdDG" & "_" & Format(Date, "ddmmyy") & ".xls"[/FONT]
 
[FONT=Times New Roman]   [COLOR=blue]Set[/COLOR] Objsheet = ObjExcel.ActiveWorkbook.Worksheets(1)                    [/FONT]
 
[FONT=Times New Roman]   [COLOR=blue]With[/COLOR] Objsheet                                                           [/FONT]
[FONT=Times New Roman]       .Rows("1:1").Font.Bold = [COLOR=blue]True[/COLOR]  [/FONT]
[FONT=Times New Roman]       .Rows("1:1").Font.Underline = xlUnderlineStyleSingle [/FONT]
[FONT=Times New Roman]       .Rows("1:1").Select [/FONT]
[FONT=Times New Roman]       Selection.Insert Shift:=xlDown[/FONT]
[FONT=Times New Roman]       Range("A1").Select  [/FONT]
[FONT=Times New Roman]       ActiveCell.FormulaR1C1 = "Standard D & G "[/FONT]
[FONT=Times New Roman]       Range("B1").Select[/FONT]
[FONT=Times New Roman]       ActiveCell.FormulaR1C1 = "Date:"[/FONT]
[FONT=Times New Roman]       Range("D1").Select [/FONT]
[FONT=Times New Roman]       ActiveCell.FormulaR1C1 = MyDate    [/FONT]
[FONT=Times New Roman]       [COLOR=blue]With[/COLOR] Selection[/FONT]
[FONT=Times New Roman]           .HorizontalAlignment = xlLeft  [/FONT]
[FONT=Times New Roman]           .VerticalAlignment = xlBottom[/FONT]
[FONT=Times New Roman]       [COLOR=blue]End With[/COLOR][/FONT]
[FONT=Times New Roman]       Range("A3:A34").Select[/FONT]
[FONT=Times New Roman]       Selection.Font.ColorIndex = 3[/FONT]
[FONT=Times New Roman]       Selection.Font.Bold = [COLOR=blue]True[/COLOR][/FONT]
[FONT=Times New Roman]       .Columns("A:CZ").Select                                              [/FONT]
[FONT=Times New Roman]       .Columns("A:CZ").EntireColumn.AutoFit                                [/FONT]
[FONT=Times New Roman]       .Columns("A:CZ").HorizontalAlignment = xlCenter                      [/FONT]
[FONT=Times New Roman]       .Columns("A:CZ").VerticalAlignment = xlCenter                        [/FONT]
[FONT=Times New Roman]   [COLOR=blue]End With[/COLOR][/FONT]
 
[FONT=Times New Roman]   ObjExcel.ActiveWorkbook.Save                                            [/FONT]
[FONT=Times New Roman]   ObjExcel.ActiveWorkbook.Close                                           [/FONT]
[FONT=Times New Roman]   ObjExcel.Quit                                                           [/FONT]
 
[FONT=Times New Roman]   [COLOR=blue]Dim[/COLOR] olApp As Outlook.Application                                        [/FONT]
[FONT=Times New Roman]   [COLOR=blue]Dim[/COLOR] olMail As MailItem                                                  [/FONT]
 
[FONT=Times New Roman]   [COLOR=blue]Set[/COLOR] olApp = New Outlook.Application                                     [/FONT]
[FONT=Times New Roman]   [COLOR=blue]Set[/COLOR] olMail = olApp.CreateItem(olMailItem)                               [/FONT]
 
[FONT=Times New Roman]   [COLOR=blue]With[/COLOR] olMail[/FONT]
[FONT=Times New Roman]   .To = "John.Lee@domesticandgeneral.com"[/FONT]
[FONT=Times New Roman]   .CC = "David.Newman@domesticandgeneral.com"[/FONT]
[FONT=Times New Roman]   .BCC = "elaine.boulton@domesticandgeneral.com"[/FONT]
[FONT=Times New Roman]   .Subject = "Standard D & G Spreadsheet"[/FONT]
[FONT=Times New Roman]   .Body = "Please find attached the Standard D & G Excel Spreadsheet."[/FONT]
[FONT=Times New Roman]   .Attachments.Add "H:\John Lee\StdDG" & "_" & Format(Date, "ddmmyy") & ".xls"[/FONT]
[FONT=Times New Roman]   .Send[/FONT]
[FONT=Times New Roman]   [COLOR=blue]End With[/COLOR][/FONT]
 
[FONT=Times New Roman]   [COLOR=blue]Set[/COLOR] olMail = [COLOR=blue]Nothing[/COLOR]    [/FONT]
[FONT=Times New Roman]   [COLOR=blue]Set[/COLOR] olApp = [COLOR=blue]Nothing[/COLOR]     [/FONT]
 
[COLOR=blue][FONT=Times New Roman]End If[/FONT][/COLOR]
 
[FONT=Times New Roman]DoCmd.Echo [COLOR=blue]True[/COLOR], "Program End"                                              [/FONT]
[FONT=Times New Roman]DoCmd.Hourglass [COLOR=blue]False[/COLOR]  [/FONT]
[FONT=Times New Roman]DoCmd.SetWarnings [COLOR=blue]True[/COLOR] [/FONT]
 
[COLOR=blue][FONT=Times New Roman]End Function[/FONT][/COLOR]

I know that the number of columns will never exceed A:CZ, but the number of rows change from day to day.

I want to be able to create the sum function for each of the columns according to the last row of data position at the time of creating the spreadsheet, but I'm at a loss as to how I achieve that, I remember doing something like that years ago but the how evades me currently.

Any assistance would be greatfully received.

John

Edit : You will that the range A3:A34 identifies the current explicit range, but this range needs to be able to change according to any additional rows of data that will be added. So the A3:A34 could on Monday Be A3:A37, and so I need to be able to accommodate this aspect.

John
 
Here are some snippets of code that I used to do formatting of a spreadsheet and then to create the totals in the last row:

Code: 
Dim LastRow As Long
Dim c As Integer
Dim i As Integer
 
'find the last used cell in Column "B" (Center)
LastRow = objXLSheet.Range("B65536").End(xlUp).Row

Use the code above specifying a column you your sheet that will always have every row populated with some value.

Code: 
'Add "TOTALS" text and formatting
objXLSheet.Range("B" & LastRow + 1).Value = "TOTALS"
 
'show the cell borders
With objXLSheet.Range("B3:R" & LastRow + 1).Borders
   .LineStyle = xlContinuous
   .Weight = xlThin
End With
 
 
'make all blank cells to have a zero instead of just blank
For c = 6 To 17
   'add the TOTALS formula below the last row
   objXLSheet.Cells(i, c).FormulaR1C1 = "=SUM(R[-" & StartRow & "]C:R[-1]C)"
Next c

Use your forumla and watch for wrapping in the code above.

Hopefully this will give you a nudge in the right direction.
 
Hi Mr B.

Thanks for your pointers, I've been working on this, this afternoon and this is what I have so far [see code in red]

Code: 
[FONT=Times New Roman]    [COLOR=blue]Set[/COLOR] Objsheet = ObjExcel.ActiveWorkbook.Worksheets(1)                    [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    [COLOR=blue]With[/COLOR] Objsheet                                                           [/FONT]
[FONT=Times New Roman]        .Rows("1:1").Font.Bold = [COLOR=blue]True[/COLOR]  [/FONT]
[FONT=Times New Roman]        .Rows("1:1").Font.Underline = xlUnderlineStyleSingle [/FONT]
[FONT=Times New Roman]        .Rows("1:1").Select [/FONT]
[FONT=Times New Roman]        Selection.Insert Shift:=xlDown[/FONT]
[FONT=Times New Roman]        Range("A1").Select  [/FONT]
[FONT=Times New Roman]        ActiveCell.FormulaR1C1 = "Standard D & G "[/FONT]
[FONT=Times New Roman]        Range("B1").Select[/FONT]
[FONT=Times New Roman]        ActiveCell.FormulaR1C1 = "Date:"[/FONT]
[FONT=Times New Roman]        Range("D1").Select [/FONT]
[FONT=Times New Roman]        ActiveCell.FormulaR1C1 = MyDate    [/FONT]
[FONT=Times New Roman]        [COLOR=blue]With[/COLOR] Selection[/FONT]
[FONT=Times New Roman]            .HorizontalAlignment = xlLeft  [/FONT]
[FONT=Times New Roman]            .VerticalAlignment = xlBottom[/FONT]
[FONT=Times New Roman]        [COLOR=blue]End With[/COLOR][/FONT]
[FONT=Times New Roman]        [/FONT]
[FONT=Times New Roman]        [COLOR=red].Columns("A:CQ").Select    [/COLOR][/FONT]
[COLOR=red][FONT=Times New Roman]        .Columns("A:CQ").EntireColumn.AutoFit [/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        .Columns("A:CQ").HorizontalAlignment = xlCenter [/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        .Columns("A:CQ").VerticalAlignment = xlCenter      [/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        [/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        Dim LastRow As Long[/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        [/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        LastRow = Objsheet.Range("A65536").End(xlUp).Row[/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        [/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        Objsheet.Range("A" & LastRow + 1).FormulaR1C1 = "=SUM(R[-" & LastRow & "]C:R[-1]C)"[/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        With Objsheet.Range("A3:CP" & LastRow + 1).Borders[/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]             .LineStyle = xlContinuous[/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]             .Weight = xlThin[/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        End With[/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        [/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        Range("A" & LastRow + 1).Font.ColorIndex = 3[/FONT][/COLOR]
[COLOR=red][FONT=Times New Roman]        Range("A" & LastRow + 1).Font.Bold = True[/FONT][/COLOR]
[FONT=Times New Roman]    [COLOR=blue]End With[/COLOR][/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    ObjExcel.ActiveWorkbook.Save                                            [/FONT]
[FONT=Times New Roman]    ObjExcel.ActiveWorkbook.Close                                           [/FONT]
[FONT=Times New Roman]    ObjExcel.Quit                                                           [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] olApp As Outlook.Application                                        [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Dim[/COLOR] olMail As MailItem                                                  [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Set[/COLOR] olApp = New Outlook.Application                                     [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Set[/COLOR] olMail = olApp.CreateItem(olMailItem)                               [/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    [COLOR=blue]With[/COLOR] olMail[/FONT]
[FONT=Times New Roman]    .To = "John.Lee@domesticandgeneral.com"[/FONT]
[FONT=Times New Roman]    .CC = "David.Newman@domesticandgeneral.com"[/FONT]
[FONT=Times New Roman]    .BCC = "elaine.boulton@domesticandgeneral.com"[/FONT]
[FONT=Times New Roman]    .Subject = "Standard D & G Spreadsheet"[/FONT]
[FONT=Times New Roman]    .Body = "Please find attached the Standard D & G Excel Spreadsheet."[/FONT]
[FONT=Times New Roman]    .Attachments.Add "H:\John Lee\StdDG" & "_" & Format(Date, "ddmmyy") & ".xls"[/FONT]
[FONT=Times New Roman]    .Send[/FONT]
[FONT=Times New Roman]    [COLOR=blue]End With[/COLOR][/FONT]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Set[/COLOR] olMail = [COLOR=blue]Nothing[/COLOR]    [/FONT]
[FONT=Times New Roman]    [COLOR=blue]Set[/COLOR] olApp = [COLOR=blue]Nothing[/COLOR]     [/FONT]
[FONT=Times New Roman] [/FONT]
[COLOR=blue][FONT=Times New Roman]End If[/FONT][/COLOR]
[FONT=Times New Roman] [/FONT]
[FONT=Times New Roman]DoCmd.Echo [COLOR=blue]True[/COLOR], "Program End"                                              [/FONT]
[FONT=Times New Roman]DoCmd.Hourglass [COLOR=blue]False[/COLOR]  [/FONT]
[FONT=Times New Roman]DoCmd.SetWarnings [COLOR=blue]True[/COLOR] [/FONT]
[FONT=Times New Roman] [/FONT]
[COLOR=blue][FONT=Times New Roman]End Function[/FONT][/COLOR]

What am having a hard time trying to do now is to get the formulae to copy across the bottom of all the colums from A through to CQ.

The formulae "Sum(R[-" & LastRow & "]C:R[-1]C)" always starts at A1 and needs to start from row A3 because that is where the data to be calculated starts from and this would be the case for each column through to CQ.

I'm also having trouble trying to work out how to get the last row gridlines to be bold.

Any assistance would be most appreciated.

John
 
You must log in or register to reply here.

Similar threads

D
Solved Formatting Excel File from Access
Replies
5
Views
1,042
Eugene-LS
Eugene-LS
L
Retrieve excel from access (vol 4) , extended format , alternative color
Replies
7
Views
901
arnelgp
arnelgp
J
Opening & formatting Excel spreadsheet from VBA
Replies
7
Views
3,551
J_Orrell
J
P
how to export or save as in vba code
Replies
0
Views
1,057
pujangga2007
P
C
  • Locked
Modifying text formatting in 1 column on Export from Access to Excel
Replies
14
Views
2,184
Cark
C

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom