Exporting to excel worksheets

[KimberlyBarkman]

I currently export data, on the data row, to csv files, which our users open in excel. I need to export data to multiple sheets within a single excel file. Is there a way to do this? Can the worksheets be named within actuate?

 

[Gamecock]

Try This. It is a function I call from an Actuate report.
--------------------------------------------------------

Class ExcelExportVisitor Subclass of AcVisitor

Dim theExcelApp As AcExcelApp
Dim theExcelWorkbook As AcExcelWorkbook
Dim theExcelWorksheet As AcExcelWorksheet
Dim theExcelWorksheet1 As AcExcelWorksheet'ALL
Dim theExcelWorksheet2 As AcExcelWorksheet'TLP
Dim theExcelWorksheet3 As AcExcelWorksheet'CPI
Dim theExcelWorksheet4 As AcExcelWorksheet'WIN
Dim theExcelWorksheet5 As AcExcelWorksheet'MCPI





Dim currentCell As AcExcelCell

Dim i_currentRow As Integer

Dim i_startColumn As Integer
Dim i_endColumn As Integer

Dim c_title As String
Dim c_workbookName As String

Dim sta_theControlTypes() As ExcelControlType


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub New()
Set theExcelApp = New AcExcelApp
Set theExcelWorkbook = theExcelApp.AddWorkBook()
Set theExcelWorksheet = theExcelWorkbook.AddWorkSheet()
Set theExcelWorksheet1 = theExcelWorkbook.AddWorkSheet()'ALL
Set theExcelWorksheet2 = theExcelWorkbook.AddWorkSheet()'TLP
Set theExcelWorksheet3 = theExcelWorkbook.AddWorkSheet()'CPI
Set theExcelWorksheet4 = theExcelWorkbook.AddWorkSheet()'WIN
Set theExcelWorksheet5 = theExcelWorkbook.AddWorkSheet()'MCPI


i_CurrentRow = 1

End Sub


Sub ALL_Worksheet()
worksheet = "ALL"
i_CurrentRow = 1
End Sub

Sub TLP_Worksheet()
worksheet = "TLP"
i_CurrentRow = 1
End Sub

Sub CPI_Worksheet()
worksheet = "CPI"
i_CurrentRow = 1
End Sub

Sub WIN_Worksheet()
worksheet = "WIN"
i_CurrentRow = 1
End Sub

Sub MCPI_Worksheet()
worksheet = "MCPI"
i_CurrentRow = 1
End Sub


Sub AllocateColumns (startColumn As Integer, endColumn As Integer)
i_startColumn = startColumn
i_endColumn = endColumn
Redim sta_theControlTypes (i_startColumn to i_endColumn)
End Sub

Sub SetTitle (title As String)
c_title = title
End Sub

Sub SetWorkbookName (workbookName As String)
c_workbookName = workbookName
End Sub

Sub AddControl (column As Integer, columnHeader As String, controlName As String, columnWidth As Double)
sta_theControlTypes(column).c_columnHeader = columnHeader
sta_theControlTypes(column).c_controlName = controlName
sta_theControlTypes(column).d_columnWidth = columnWidth
sta_theControlTypes(column).b_isNumeric = False

'This is set to true because the first row is filled with the column headers
sta_theControlTypes(column).b_isFilled = True
End Sub

Sub VisitPageList( o_pageList As AcPageList )
Dim o_iter As AcIterator
Dim o_content As AcReportComponent
Dim i_counter As Integer

Set o_iter = o_PageList.Pages.NewIterator( )
Do While o_iter.HasMore( )
Set o_content = o_iter.GetNext( )
o_content.ApplyVisitor(me)
Loop

'Need to export the last row
ExportRow()

' Used in IF statements below
Dim i_column As Integer

If worksheet = "GNS" then
theExcelWorksheet.SetName(c_title)

' theExcelWorksheet.Autofit() 'This is used for autofit applied to worksheet
' The following code autofit columns specified columnWidth with 0 using addControl method
' Dim i_column As Integer
For i_column = i_startColumn To i_endColumn
If Abs(sta_theControlTypes(i_column).d_columnWidth) < 1.0e-5 Then
theExcelWorksheet.getColumn(i_column).Autofit()
End If
Next i_column
End If

' Code Below was added by Thomas Walls
If worksheet = "ALL" then
theExcelWorksheet1.SetName("ALL")'ALL

' theExcelWorksheet.Autofit() 'This is used for autofit applied to worksheet
' The following code autofit columns specified columnWidth with 0 using addControl method
' Dim i_column As Integer
For i_column = i_startColumn To i_endColumn
If Abs(sta_theControlTypes(i_column).d_columnWidth) < 1.0e-5 Then
theExcelWorksheet1.getColumn(i_column).Autofit()
End If
Next i_column
End If

If worksheet = "TLP" then
theExcelWorksheet2.SetName("TLP")'TLP

' theExcelWorksheet.Autofit() 'This is used for autofit applied to worksheet
' The following code autofit columns specified columnWidth with 0 using addControl method
' Dim i_column As Integer
For i_column = i_startColumn To i_endColumn
If Abs(sta_theControlTypes(i_column).d_columnWidth) < 1.0e-5 Then
theExcelWorksheet2.getColumn(i_column).Autofit()
End If
Next i_column

End If


If worksheet = "CPI" then
theExcelWorksheet3.SetName("CPI")'CPI

' theExcelWorksheet.Autofit() 'This is used for autofit applied to worksheet
' The following code autofit columns specified columnWidth with 0 using addControl method
' Dim i_column As Integer
For i_column = i_startColumn To i_endColumn
If Abs(sta_theControlTypes(i_column).d_columnWidth) < 1.0e-5 Then
theExcelWorksheet3.getColumn(i_column).Autofit()
End If
Next i_column

End If


If worksheet = "WIN" then
theExcelWorksheet4.SetName("WIN")'WIN

' theExcelWorksheet.Autofit() 'This is used for autofit applied to worksheet
' The following code autofit columns specified columnWidth with 0 using addControl method
' Dim i_column As Integer
For i_column = i_startColumn To i_endColumn
If Abs(sta_theControlTypes(i_column).d_columnWidth) < 1.0e-5 Then
theExcelWorksheet4.getColumn(i_column).Autofit()
End If
Next i_column

End If


If worksheet = "MCPI" then
theExcelWorksheet5.SetName("MCPI")'MCPI

' theExcelWorksheet.Autofit() 'This is used for autofit applied to worksheet
' The following code autofit columns specified columnWidth with 0 using addControl method
' Dim i_column As Integer
For i_column = i_startColumn To i_endColumn
If Abs(sta_theControlTypes(i_column).d_columnWidth) < 1.0e-5 Then
theExcelWorksheet5.getColumn(i_column).Autofit()
End If
Next i_column

End If


' ---------- Save To Excel -----------

theExcelWorkbook.SaveAs(c_workbookName)


End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub VisitLabelControl(myControl As AcLabelControl)
Dim c_value As Variant
Dim i_columnPosition As Integer

Super::VisitLabelControl(myControl)

c_value = myControl.Text
i_columnPosition = FindPosition(myControl)

PlaceValue(c_value, i_columnPosition, False, "")
End Sub

Sub VisitIntegerControl(myControl As AcIntegerControl)
Dim c_value As Variant
Dim i_columnPosition As Integer

Super::VisitIntegerControl(myControl )

c_value = myControl.DataValue
i_columnPosition = FindPosition(myControl)

PlaceValue(c_value, i_columnPosition, True, myControl.Format())
End Sub

Sub VisitTextControl(myControl As AcTextControl )
Dim c_value As String
Dim i_columnPosition As Integer

Super::VisitTextControl(myControl)

c_value = myControl.DataValue
i_columnPosition = FindPosition(myControl)

PlaceValue(c_value, i_columnPosition, False, "")
End Sub

Sub VisitDoubleControl(myControl As AcDoubleControl)
Dim c_value As Variant
Dim i_columnPosition As Integer

Super::VisitDoubleControl(myControl)

c_value = myControl.DataValue
i_columnPosition = FindPosition(myControl)

PlaceValue(c_value, i_columnPosition, False, "")
End Sub

Sub VisitCurrencyControl(myControl As AcCurrencyControl )
Dim c_value As Variant
Dim i_columnPosition As Integer

Super::VisitCurrencyControl(myControl)

c_value = myControl.DataValue
i_columnPosition = FindPosition(myControl)

PlaceValue(c_value, i_columnPosition, True, myControl.Format())
End Sub

Sub VisitDateTimeControl(myControl As AcDateTimeControl )
Dim c_value As Variant
Dim i_columnPosition As Integer

Super::VisitDateTimeControl(myControl)

c_value = myControl.DataValue
i_columnPosition = FindPosition(myControl)

PlaceValue(c_value, i_columnPosition, False, "")
End Sub





'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Function FindPosition (ByVal myControl As AcVisualComponent) As Integer
'Returns -1 if the control is not among those to be displayed
Dim c_className As String
Dim i_counter As Integer

c_className = GetClassName(myControl)
For i_counter = i_startColumn To i_endColumn
If Instr(sta_theControlTypes(i_counter).c_controlName,c_className) > 0 Then
FindPosition = i_counter
Exit Function
End If
Next i_counter
FindPosition = -1
End Function


Sub PlaceValue (c_value As Variant, i_index As Integer, b_isNumeric As Boolean, c_Format As String)
'Sets the value of an ExcelControlType
'If it finds that a particular ExcelControlType has already been filled
'for the current row, it exports the current row and starts filling the new one.
If (i_index = -1) Then
Exit Sub
End If

If sta_theControlTypes(i_index).b_isFilled = True Then
ExportRow()
End If

sta_theControlTypes(i_index).c_dataValue = c_value
sta_theControlTypes(i_index).b_isFilled = True
sta_theControlTypes(i_index).b_isNumeric = b_isNumeric
sta_theControlTypes(i_index).c_Format = c_Format


End Sub

Sub ExportRow ()
Dim i_column As Integer
Dim myColumn As AcExcelColumn

If i_currentRow = 1 Then
For i_column = i_startColumn To i_endColumn
If worksheet = "GNS" then
Set myColumn = theExcelWorksheet.GetColumn(i_column)
ElseIF worksheet = "ALL" then
Set myColumn = theExcelWorksheet1.GetColumn(i_column)
ElseIF worksheet = "TLP" then
Set myColumn = theExcelWorksheet2.GetColumn(i_column)
ElseIF worksheet = "CPI" then
Set myColumn = theExcelWorksheet3.GetColumn(i_column)
ElseIF worksheet = "WIN" then
Set myColumn = theExcelWorksheet4.GetColumn(i_column)
ElseIF worksheet = "MCPI" then
Set myColumn = theExcelWorksheet5.GetColumn(i_column)
End If
myColumn.SetColumnWidth(sta_theControlTypes(i_column).d_columnWidth)
ExportCell(i_column, sta_theControlTypes(i_column), True)
Next i_column
Else
For i_column = i_startColumn To i_endColumn
ExportCell(i_column, sta_theControlTypes(i_column), False)
Next i_column
End If

i_currentRow = i_currentRow + 1

End Sub

Sub ExportCell (i_column As Integer, excelType As ExcelControlType, b_isHeader as Boolean)

Dim myFont As AcFont
Dim value As Variant
Dim b_isNumeric As Boolean
Dim c_Format As String

If (b_isHeader = True) Then
value = excelType.c_columnHeader
Else
value = excelType.c_dataValue
End If

If worksheet = "GNS" then
Set currentCell = theExcelWorksheet.GetCell(i_currentRow, i_column)
ElseIF worksheet = "ALL" then
Set currentCell = theExcelWorksheet1.GetCell(i_currentRow, i_column)
ElseIF worksheet = "TLP" then
Set currentCell = theExcelWorksheet2.GetCell(i_currentRow, i_column)
ElseIF worksheet = "CPI" then
Set currentCell = theExcelWorksheet3.GetCell(i_currentRow, i_column)
ElseIF worksheet = "WIN" then
Set currentCell = theExcelWorksheet4.GetCell(i_currentRow, i_column)
ElseIF worksheet = "MCPI" then
Set currentCell = theExcelWorksheet5.GetCell(i_currentRow, i_column)
End If


' Make sure to call SetValue BEFORE SetNumberFormat when the data type
' is Date or Currency
currentCell.SetValue(value)
myFont = currentCell.GetFont()
myFont.Bold = b_isHeader
myFont.Size = 10
currentCell.SetFont(myFont)
If (excelType.b_isNumeric = True) Then
If (excelType.c_Format <> "") Then
currentCell.SetNumberFormat(excelType.c_Format)
End If
End If

sta_theControlTypes(i_column).b_isFilled = False
'We do not wipe out the previous row because we will repeat values
'if values are not changed

End Sub


End Class

Declare
Type ExcelControlType
c_columnHeader As String
c_controlName As String
c_dataValue As Variant
c_Format As String
d_columnWidth As Double
b_isNumeric As Boolean
b_isFilled As Boolean
End Type

End Declare