I was hoping I could be directed to a previously written macro I can copy to use to convert a BO report with more than one tab to an excel spreadsheet with the BO tabs converted to different sheets.
[moved to SDK forum - Andreas]
UnivarHB (BOB member since 2004-10-14)
Where can I get it?
UnivarHB (BOB member since 2004-10-14)
Just click on the hyperlink Michael provided and download the file from there…
Andreas 
(BOB member since 2002-06-20)
If that doesn’t work for you, let me know. I have something that should do what you want.
dirmiger 
(BOB member since 2002-08-28)
The add in doesn’t work well with Excel in that the column headings don’t convert correctly. But I am dealing with it with an excel macro to delete and recreate them. Also, I have to run the BO macro on each Document and then create separate excel files.
So what can you offer me? I’d be interested in taking a look at it.
Thanks
UnivarHB (BOB member since 2004-10-14)
Here is something that works for us using 5.1.6:
(BOB member since 2002-08-08)' Copy the Active Report to an instance of Excel using the Clipboard
Sub CopyToExcel()
Dim intReport As Integer
Dim boActiveReport As busobj.Report
Dim boEditPopup As busobj.CmdBarPopup
Dim xlFormatPopup As Office.CommandBarPopup
Dim xlColumnPopup As Office.CommandBarPopup
Dim objExcel As Excel.Application
Dim xlWorkSheet As Excel.Worksheet
Dim xlActiveSheet As Excel.Worksheet
Dim strName As String
' If there is no active report, exit
If busobj.Application.ActiveDocument Is Nothing Then Exit Sub
' Set the error trap
On Error GoTo ErrorHandler
' Start a new instance of Excel
Set objExcel = New Excel.Application
objExcel.Visible = True
objExcel.Interactive = True
objExcel.WindowState = xlMaximized
' Create a workbook
objExcel.SheetsInNewWorkbook = 1
objExcel.Workbooks.Add
Set xlActiveSheet = objExcel.Worksheets(1)
Set boEditPopup = busobj.Application.CmdBars(2).Controls("&Edit")
' Create a worksheet for each report in the active document
With busobj.Application.ActiveDocument
Set boActiveReport = .ActiveReport ' to be restored when we are done
For intReport = 1 To .Reports.Count
.Reports(intReport).Activate ' Traverse the BO reports
' Execute a BO CopyAll function to bring the report's contents
' into the Windows Clipboard
boEditPopup.CmdBar.Controls("Cop&y All").Execute
If intReport = 1 Then
Set xlWorkSheet = objExcel.Worksheets(1)
Else
Set xlWorkSheet = objExcel.Worksheets.Add(, xlWorkSheet)
End If
If .Reports(intReport).Name = boActiveReport.Name Then Set xlActiveSheet = xlWorkSheet
' Set the Excel tab to BO tab
strName = .ActiveReport.Name
strName = Replace(strName, ":", "") ' Can't contain this character
strName = Replace(strName, "\", "") ' Can't contain this character
strName = Replace(strName, "/", "") ' Can't contain this character
strName = Replace(strName, "?", "") ' Can't contain this character
strName = Replace(strName, "*", "") ' Can't contain this character
strName = Replace(strName, "[", "") ' Can't contain this character
strName = Replace(strName, "]", "") ' Can't contain this character
strName = Left(strName, 31)
xlWorkSheet.Name = strName
' Paste the contents of the Windows Clipboard onto the active worksheet
xlWorkSheet.Paste
' Execute the Excel Format->Column->AutoFit Selection menu choice
Set xlFormatPopup = Excel.Application.CommandBars(1).Controls("F&ormat")
Set xlColumnPopup = xlFormatPopup.CommandBar.Controls("&Column")
xlColumnPopup.CommandBar.Controls("&AutoFit Selection").Execute
Next intReport
boActiveReport.Activate ' restore last active BO report
End With
' Clean up and quit
xlActiveSheet.Activate ' show first Excel worksheet
objExcel.WindowState = xlMinimized
Set objExcel = Nothing
MsgBox busobj.Application.ActiveDocument.Reports.Count & _
" reports copied to Excel", _
vbOKOnly, _
"Copy complete"
Exit Sub
' Error handler
ErrorHandler:
If Err.Number = 1004 Then
' Sheet name not unique
If Right(strName, 1) = " " Then Mid(strName, Len(strName), 1) = "A"
strName = Left(strName, Len(strName) - 1) & Chr(Asc(Right(strName, 1)) + 1)
Resume
Else
' Unhandled error
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Sub
' General purpose Replace function. Since VBA does not seem
' to have the VB6 Replace function yet...
Private Function Replace(strString As String, _
strSearch As String, _
strReplaceWith As String) As String
Dim strWork As String ' temporary work string
Dim intPos As Integer ' position of search string
Dim intSearchLength As Integer ' length of search string
Dim intReplaceWithLength As Integer ' length of replacement string
' Assumptions:
' 1) all occurrances of strSearch are to be replaced with
' strReplaceWith
' 2) the comparision used by Instr function is default
strWork = strString ' Change local variable strWork
intPos = 1 ' Start from the beginning
intSearchLength = Len(strSearch) ' Determine lengths only once
intReplaceWithLength = Len(strReplaceWith) ' Ditto
' Repeat until strSearch is no longer found in strWork
Do
intPos = InStr(intPos, strWork, strSearch)
If intPos = 0 Then Exit Do ' not found: exit loop
strWork = Left$(strWork, intPos - 1) & _
strReplaceWith & _
Mid$(strWork, intPos + intSearchLength)
intPos = intPos + Len(strReplaceWith)
Loop
' Return strWork as the value of this function
Replace = strWork
End Function
dirmiger (BOB member since 2002-08-28)
I get an error:
User-defined type not defined
on this line:
Dim xlFormatPopup As Office.CommandBarPopup
UnivarHB (BOB member since 2004-10-14)
You’ll need to check the Microsoft 9.0 Excel reference under Tools->References. You might also need Microsoft 9.0 Office, but try it to see.
dirmiger (BOB member since 2002-08-28)
I’m running Microsoft Office 2003
UnivarHB (BOB member since 2004-10-14)
Fine. Enable whichever reference to Excel/Office that appears in the list under Tools->References.
dirmiger (BOB member since 2002-08-28)