Has anyone ever done this ?
I have to produce an excel report that has 35 columns. What I would like to do is have a document that a user can select attributes for each column:
Column A - Header Name, font selections (color, bold/italic, etc)., Horizontal/Vertical Alignment
Column B - Header Name
Column C - Header Name, Highlight/No Highlight
.
.
.
From here, I can have my script read in each column setting and crank out the spreadsheet.
Any ideas would be great.
Thank you
Subject: Creating an Excel format document
There is a ton of stuff on this site for working with Excel so I would recommend searching for an answer before asking. That being said here is some code to get you started.
Sets up an Excel workbook for export
Sub BillingReport
'Modified from SupplierRequest
'By TBQ 10-9-02
'Frontend Notes Objects
Dim WS As NotesUIWorkspace
'Backend Notes Objects
Dim Session As NotesSession
Dim DB As NotesDatabase
Dim OutputColl As NotesDocumentCollection
Dim CurrDoc As NotesDocument
Dim NextDoc As NotesDocument
' Variable for Processing Controls
Dim ProjectArray As Variant
Dim ProjectType As Variant
Dim ProjectCount As Integer
Dim SheetsCount As Integer
Dim I As Integer
Dim Continue As Integer
Dim Pointer As Integer
’ Dim Choices (1 To 2) As String
'OLE Objects
Dim XLApp As Variant
Dim XLBook As Variant ' Only 1 of these.
Dim XLSheet As Variant
Dim XLWorksheets As Variant
'Initialize values
Set WS = New NotesUIWorkspace
Set Session = New NotesSession
Set DB = Session.CurrentDatabase
Set OutputColl = DB.UnprocessedDocuments
’ Choices(1) = “External Projects Only”
’ Choices(2) = “Both Internal & External Projects”
'Check number of document
If OutputColl.Count = 0 Then
Msgbox "You have not selected any time sheets to export, ending.", 0 + 64, "Problem with selection"
End
End If
'Ask user for "External Projects Only" or "Both Internal & External Projects"
ProjectType = WS.Prompt( PROMPT_YESNOCANCEL, "All Project Types Export", "Yes for Internal & External Projects, No for External Projects Only")
If Int(ProjectType) <> -1 Then
'User did not hit cancel
'Initalize OLE Objects
Set XLApp = CreateObject( "excel.application" )
XLApp.Visible = False
Set XLBook = XLApp.Workbooks.Add
Set XLWorksheets = XLBook.Worksheets
' Suppress display of any alerts the user might see.
XLApp.DisplayAlerts = False
' Delete any excess sheets, to allow only 1 to remain.
SheetsCount = XLWorksheets.Count
For I = SheetsCount To 2 Step -1
XLWorksheets( I ).Delete
Next
' Turn display of alerts back on.
XLApp.DisplayAlerts = True
'DEBUG SHOW APP BEFORE PROBLEM ELSE SHOW BELOW
'XLApp.Visible = True
'Returns array of all projects (ordered)
ProjectArray = CreateProjectList(OutputColl, Int(ProjectType))
ProjectCount = Ubound(ProjectArray)
'Label Tabs with Projects (To know where to place output
For Pointer = 1 To ProjectCount
If Pointer = 1 Then
Set XLSheet = XLWorksheets( 1 )
Else
Set XLSheet = XLBook.Worksheets.Add
End If
XLSheet.Name = ProjectArray(Pointer)
Next
'Write values to correct spreadsheet
Set CurrDoc = OutputColl.GetFirstDocument
While Not(CurrDoc Is Nothing)
Set NextDoc = OutputColl.GetNextDocument(CurrDoc)
Call WriteDocDetails(CurrDoc, XLWorksheets, Int(ProjectType))
Call WriteAllSlipDetails(CurrDoc, XLWorksheets, Int(ProjectType))
Set CurrDoc = NextDoc
Wend
'Setup Headers, Footers, and Print Options on Worksheets
XLApp.Visible = True
Call WriteExcelFooters(XLWorksheets)
Call FormatExcelPrintOptions(XLWorksheets)
Call SetupExcelHeaders(XLWorksheets)
'Special Header for All Slips Page
Call SetupAllSlipHeader(XLWorkSheets)
Call SortResults(XLAPp, XLWorksheets)
End If
End Sub
Format Headers
Sub SetupExcelHeaders(XLWorksheets As Variant)
' To effectively use Excel's built-in constants, will need to get list of predefined
' values, OR determine way to include the constants into the LotusScript library.
'FROM VBA NORTHBOUND
’ ActiveCell.Offset(0, 9).FormulaR1C1 = “=RC[-4]*RC[-2]”
’ ActiveCell.Offset(1, 0).Select
’ Selection.EntireRow.Insert
Forall XLSheets In XLWorksheets
With XLSheets
If XLSheets.Name <> "All Slips" Then
'Set Page Headers
.Cells( 1, 1 ) = "Todd Herman & Associates PA"
.Cells( 1, 1 ).Font.Bold = True
.Cells( 2, 1 ) = "Billing Summary Output - " + XLSheets.Name
'Set Column Width & Format Options
.Cells( 1, ItemNumberCol + 0 ).Font.Bold = True
.Cells( 1, ItemNumberCol + 0 ).ColumnWidth = 17
.Cells( 1, ItemNumberCol + 1).Font.Bold = True
.Cells( 1, ItemNumberCol + 1 ).ColumnWidth = 5
.Cells( 1, ItemNumberCol + 2 ).Font.Bold = True
.Cells( 1, ItemNumberCol + 2 ).Font.Bold = True
.Cells( 1, ItemNumberCol + 3 ).Font.Bold = True
If .Cells( 1, ItemNumberCol + 3 ).ColumnWidth < 10 Then
.Cells( 1, ItemNumberCol + 3 ).ColumnWidth = 10
End If
.Cells( 1, ItemNumberCol + 4 ).Font.Bold = True
.Cells( 1, ItemNumberCol + 4 ).ColumnWidth = 8
'Set Column Headers
.Cells( 4, ItemNumberCol + 0 ) = "Date"
.Cells( 4, ItemNumberCol + 1 ) = "Time"
.Cells( 4, ItemNumberCol + 2 ) = "Activity"
.Cells( 4, ItemNumberCol + 3 ) = "Description"
.Cells( 4, ItemNumberCol + 4 ) = "Location"
'Borders for apperances
With .Range("A4:E4").Borders( xlBottom )
.LineStyle = 1
.Weight = 3
End With
End If
End With
End Forall
End Sub
Writes Footers
Sub WriteExcelFooters(XLWorksheets As Variant)
'FROM VBA NORTHBOUND
'ActiveCell.Offset(0, 9).FormulaR1C1 = "=RC[-4]*RC[-2]"
'relative notation in row/column format
Dim LastUsedRow As Integer
Dim FormulaString As String
'Will add formula's and borders to total hours coulmns
Forall XLSheet In XLWorksheets
With XLSheet
'For each sheet find last used row in Time Spent column (Column 2)
LastUsedRow = FindOpenRow(XLSheet, 2) -1
'Add Border to bottom of values (total line)
With .Range("B" + Cstr(LastUsedRow)).Borders( xlBottom )
.LineStyle = 2
.Weight = 1
End With
'Add text
.Cells( LastUsedRow + 1, 1 ).Font.Bold = True
.Cells( LastUsedRow + 1, 1 ) = "Total ="
'Calculate Formula in R1C1
If LastUsedRow = 5 Then
'Only single row used
FormulaString = "=Sum(R[" + Cstr((4 - LastUsedRow)) + "]C)"
Else
'Multiple Rows Used
FormulaString = "=Sum(R[" + Cstr((4 - LastUsedRow)) + "]C:R[-1]C)"
End If
'Highlight and Place into cell
.Cells( LastUsedRow + 1, 2 ).Font.Bold = True
.Cells( LastUsedRow + 1, 2 ).FormulaR1C1 = FormulaString
'Add Border to bottom of total (total line)
With .Range("B" + Cstr(LastUsedRow + 1)).Borders( xlBottom )
.LineStyle = 9
End With
End With
End Forall
End Sub