Page Break on View Export to Excel
Hello All,
I have searched diligently for logic on inserting a page break on an export to excel script depending upon the first column value. Column 1 of my view that gets exports contains 2 values, either P1 or P2. I want to insert a page break on the excel spreadsheet export between the P1 and P2.
The export logic I have works fine, I just can't find the script logic to force the pagebreak upon the export.
Please help !!
Thank you !
Paul
I have searched diligently for logic on inserting a page break on an export to excel script depending upon the first column value. Column 1 of my view that gets exports contains 2 values, either P1 or P2. I want to insert a page break on the excel spreadsheet export between the P1 and P2.
The export logic I have works fine, I just can't find the script logic to force the pagebreak upon the export.
Please help !!
Thank you !
Paul
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Hemantha! 3 minutes faster!!!!
Yes I am about to launch a rocket ...
ASKER
lol..... Hello Ranjeet things are moving right along as always.
The export is done through a script that gets executed from a button on the view.
The view is sorted by column 1, therefore the view will contain multiple fields that show all P1 in the first column then all the P2's. I want to export to excel with a page break between the P1 and P2. Upon the change of the value.
The export is done through a script that gets executed from a button on the view.
The view is sorted by column 1, therefore the view will contain multiple fields that show all P1 in the first column then all the P2's. I want to export to excel with a page break between the P1 and P2. Upon the change of the value.
Paul, have two variables one which extracts the current value from col 1, and before you get next row.. swap it with another variable and compare if they both are same.. Then use my code to get the row number and execute it.
Hemantha's code is perfect. Only you have to mix it in your code. The logic is: wherever you have to insert a page break. Well, hold. I should tell you Excel uses 2 kinds of Page breaks. Horizontal ones and vertical ones. A SHEET object has two collections. HPageBreaks and VPageBreaks. They contain one "PageBreak object" each for all the page breaks. So! To add a page break from your code, simply add a PageBreak object to this collection.
Well, hold. Actually you dont have to do that explicitly. Just call teh ADD method on HPageBreaks collection, it will create the object for you as well as add it. So, the trick is: place your pointer where you want the PageBreak to appear. In code, you do that by making a range object. So just create a range object and pass it to the HPageBreaks collection of the desired sheet. And you are done!!!
Well, hold. Actually you dont have to do that explicitly. Just call teh ADD method on HPageBreaks collection, it will create the object for you as well as add it. So, the trick is: place your pointer where you want the PageBreak to appear. In code, you do that by making a range object. So just create a range object and pass it to the HPageBreaks collection of the desired sheet. And you are done!!!
Running commentary ??
ASKER
lol..... This all sounds great. Unfortunately I'm not a wizard with enormous amounts of script.
I will work on this and let you know how I make out.
I'll have to determine where ot put the 2 variables, the exact code to capture the first value and the second and the script to compare the 2. This one is definitely going to be a challenge. I'll keep you posted on my progress.
Thank you !!
I will work on this and let you know how I make out.
I'll have to determine where ot put the 2 variables, the exact code to capture the first value and the second and the script to compare the 2. This one is definitely going to be a challenge. I'll keep you posted on my progress.
Thank you !!
That's the reason I said show me your code, I'll help you ;-)
ASKER
Dim w As NotesUIWorkspace
Dim s As NotesSession
Dim db As NotesDatabase
Dim uidoc As NotesUIDocument
Dim dc As NotesDocumentCollection
Dim excelNewWkbk As Variant
Dim excelSheet As Variant
Dim excelApp As Variant
Dim filename As Variant
Dim aDataTable() As Variant
Dim vtViewList As Variant
Dim view As NotesView
Dim taskID As Integer
Dim sRun As String
Dim x As Integer
Dim y As Integer
Dim sViewName As String
Dim Message As String
Dim excelWkbks As Variant
Dim Continue As String
Dim vtColumnTypes As Variant
Dim columnCount As Integer
Dim lngVeCount As Long
Dim lngTotal As Long
Dim vn As NotesViewNavigator
Dim ve As NotesViewEntry
Dim vec As NotesViewEntryCollection
Dim sListName As String
Dim vtFileName As Variant
Dim arrExistingLists As Variant
Dim iNumColumns As Integer
Dim arrColumns() As Variant
Dim vtColumns As Variant
Dim doc As NotesDocument
Dim arrReportTypes(1) As String
Dim vtResponse As Variant
Dim vtDocumentSet As Variant
Dim arrExportViews() As String
Dim v As NotesView
Dim iCount As Integer
Dim arrColumnOrder() As Integer
Dim vtColumnOrder As Variant
Dim docCustomExport As NotesDocument
Dim arrColumnnames() As String
Dim iSortBy As Integer
Dim arrCellValues() As Variant
Dim docTest As NotesDocument
Dim iSelectedOnly As Integer
Dim vtColumnvalue As Variant
Dim iHasCategories As Integer
Dim sErrorMsg As String
'Excel Automation Constants
Const XLYES = 1
Sub UpdateStatusBar(x As Long, total As Long)
Print "Working..." & Cstr(Round((x / total), 2)*100) & "% done"
End Sub
'-------------------------
' Returns a variant that contains a 1 or 0 for each column
'
' 1 - the column is visible and should be exported.
' 0 - the column is hidden and should not be exported.
'-------------------------
Dim vtColumnTypes()
Dim iCount As Integer
Dim iNumColumns As Integer
iNumColumns = Ubound(view.Columns)
Redim vtColumnTypes(iNumColumns)
iCount = 0
Forall col In view.Columns
If col.Ishidden Or col.IsIcon Then
vtColumnTypes(iCount) = 0 'set to not export column
Else
vtColumnTypes(iCount) = 1 'set to export
End If
iCount = iCount + 1
End Forall
GetColumnTypes = vtColumnTypes()
End Function
Sub DoExport()
On Error Goto DoExportErrorTrap
On Error 9 Goto SubscriptOutOfRangeTrap
'-------------------------
' Subroutine that exports data from view to Excel.
'-------------------------
'Insert Titles
For x = 0 To iNumColumns - 1
excelSheet.Cells(1, x + 1).value = vtColumns(vtColumnOrder(x)
Next
'-------------------------
' Start export. Get total number of entries for use in
' UpdateStatusBar function.
'-------------------------
lngVeCount = 2 'First Document starts at row 2
Set vn = view.CreateViewNav
'Get total number of entries
Set ve = vn.GetFirst
If iSelectedOnly Then
lngTotal = dc.Count
Else
While Not (ve Is Nothing)
lngTotal = lngTotal + 1
Set ve = vn.GetNext(ve)
Wend
lngTotal = lngTotal - 1
End If
'-------------------------
' Loop through all entries. If we're in selected only mode, see
' if the current entry's document is part of the unprocessed
' documents collection. If it is not, just skip that entry.
' For all other cases, process the view entry as follows:
'
' If entry is a category, output only the category column value
' for that row.
' If entry is a document, output all columns except any columns
' that are categories
' Skip all Total or Conflict type view entries. (code could be
' added later)
'-------------------------
Set ve = vn.GetFirst
While Not (ve Is Nothing)
Call UpdateStatusBar(lngVeCount
If iSelectedOnly Then
Set docTest = Nothing 'reset test doc.
If ve.IsDocument Then
Set docTest = dc.GetDocument(ve.Document
End If
End If
If iSelectedOnly And docTest Is Nothing Then
'Do Nothing
Else
'Redimension array to hold next row (clear old values)
Redim arrCellValues(iNumColumns - 1)
Select Case True
Case ve.IsCategory
'Loop through possible multi-value category column
For x = 0 To Ubound(ve.ColumnValues)
'If column isn't part of the selected list of columns to export
'(from Custom export only), then skip that column. Otherwise
'add that column in the appropriate position.
If Not Isnull(Arraygetindex(vtCol
arrCellValues(Arraygetinde
End If
Next
'Export row to excel
excelSheet.Range(excelShee
excelSheet.Cells(lngVeCoun
Case ve.IsConflict
'skip
Case ve.IsTotal
'skip
Case ve.IsDocument
'Loop through all columns in view entry
For x = 0 To iNumColumns - 1
'If the column is a category then don't show the category in this row,
'unless we're in Selected Only mode. In Selected Only mode, we must
'show the category or the category value won't make it to the export.
If vtColumns(vtColumnOrder(x)
arrCellValues(x) = ""
Else
'Set column value to variant in case it is multi-value.
vtColumnValue = ve.ColumnValues(vtColumnOr
'If column has multi-values, concatenate all values before export.
If Isarray(vtColumnValue) Then
For y = 0 To Ubound(vtColumnValue)
arrCellValues(x) = arrCellValues(x) & vtColumnValue(y) & Chr(10)
Next
Else
arrCellValues(x) = vtColumnValue
End If
End If
Next
'Export row to excel.
excelSheet.Range(excelShee
excelSheet.Cells(lngVeCoun
End Select
'Update count of processed view entries.
lngVeCount = lngVeCount + 1
End If
Set ve = vn.GetNext(ve)
Wend
Exit Sub
DoExportErrorTrap:
Msgbox "ERROR on line " & Cstr(Erl) & " (" & Cstr(Err) & ") - " & Error$
Exit Sub
SubscriptOutOfRangeTrap:
Msgbox "ERROR on line " & Cstr(Erl) & " (" & Cstr(Err) & ") - " & Error$ & _
Chr(10) & Chr(10) & "This error is most likely to occur when a column being " & _
"exported has a formula that contains a constant value, such as a single " & _
"string. If you wish to export a constant value, you need to trick Notes " & _
"into thinking it is not a constant value by adding a dummy variable in your " & _
" formula, such as ""String"" + dummyvar."
Exit Sub
End Sub
Function PromptForView() As NotesView
'-------------------------
' Prompt user for choice of exportable views. Any view beginning
' with "(Exportable" in its title will be found. The alias of this
' view can be set to allow for a more presentable name of the view.
' For example, you might call the view "(Exportable Contacts)" with
' an alias of "Contacts". The word Contacts will appear to the user
' as the name of the customizable view.
'
' If no views are found, the script ends and the user is prompted
' to not choose Customizable view
'
' This script returns the NotesView chosen by the user.
'-------------------------
Set PromptForView = Nothing
Print "Finding Exportable Views..."
'Search database for customizable export views
iCount = 0
Forall v In db.Views
If Left(v.Name, 11) = "(Exportable" Then
Redim Preserve arrExportViews(iCount)
'Get alias name if it exists, otherwise use view title.
If Isempty(v.Aliases) Then
arrExportViews(iCount) = v.Name
Else
arrExportViews(iCount) = v.Aliases(0)
End If
iCount = iCount + 1
End If
End Forall
'If no views found, then explain to user.
If iCount = 0 Then
Msgbox "No Exportable Views Found. Please try again and do not choose Customize View"
Exit Function
End If
Print "Please choose a view."
'Prompt user for which view to export
vtResponse = w.Prompt(PROMPT_OKCANCELLI
" to perform a custom export?", "", arrExportViews)
If Isempty(vtResponse) Then Exit Function
Set PromptForView = db.GetView(vtResponse)
Print ""
End Function
Function CustomizeExport() As Variant
'-------------------------
' Presents user with a dialog box where he/she can choose what fields
' are going to be exported and in what order.
'
' The field names are taken from the name of each column in the view.
'-------------------------
'Create new doc for dialog box
Set docCustomExport = db.CreateDocument
'Load dialog box with column names and order
Redim arrColumnNames(Ubound(vtCo
For x = 0 To Ubound(vtColumns)
If vtColumns(x).Title = "" Then
arrColumnNames(x) = "Column" & Cstr(x) & Space(150) & "$$$" & Cstr(x)
Else
arrColumnNames(x) = vtColumns(x).Title & Space(150) & "$$$" & Cstr(x)
End If
Next
'Set Listbox Fields
docCustomExport.ExportSour
docCustomExport.ExportSele
'Display Dialog to allow users to choose columns, column order
'and sort order.
x = w.Dialogbox("(dlgCustomExp
"Choose Fields For Export", docCustomExport, False, False)
If x = False Then Exit Function
'Return Column Order
Dim arrColumnValues() As Integer
Redim arrColumnValues(Ubound(doc
For x = 0 To Ubound(arrColumnValues)
arrColumnValues(x) = Cint(docCustomExport.Expor
Next
'Check for categorized columns. If they exist, set flag to prevent
'sorting from occuring. Since categorized columns get exported to
'their own row, a sort will cause all the categories to sort to the
'bottom or top and they won't visually match up to the row they
'belong to.
iHasCategories = False
For x = 0 To Ubound(arrColumnValues)
If vtColumns(arrColumnValues(
iHasCategories = True
End If
Next
'Assign sort column number if appropriate and exit function
If Not iHasCategories Then
iSortBy = Cint(Arraygetindex(docCust
End If
CustomizeExport = arrColumnValues
End Function
Sub ExportViewToExcel(sType As String)
'-------------------------
' Main script for exporting a view to Excel.
'
' The script determines the mode selected. It can either be all
' documents in view, or just selected documents. Then the user
' may be prompted to export the current view or a customized view.
' You can turn off that prompt using the PROMPT_FOR_CUSTOM_VIEW
' constant found below.
'
' Once the view is chosen, the script determines the view column
' order. It skips hidden columns, response columns, and columns
' with formulas equal to "". If customizable view is chosen, the
' user can select which columns to export, the order to export them,
' and what sort order they're given.
'-------------------------
'-------------------------
' Constants below allow developer to toggle prompt for customized
' view and search for exportable views in database.
'
' PROMPT_FOR_CUSTOM_VIEW:
' 0 - Do not prompt user to export customized view.
' 1 - Prompt user with choice to export customized view or current
' view. If customized view is chosen, then search for views
' depending on SEARCH_FOR_EXPORTABLE_VIEW
'
' SEARCH_FOR_EXPORTABLE_VIEW
' 0 - Do not search for views with names beginning with "(Exportable".
' Instead, if customized is chosen, the current view's name will
' be used to find the custom view to use. If the current view's name
' is, for example, Contacts \ By Name, then the script will look for
' a view named Contacts. This is useful if you want to have custom
' views for sets of related views.
' 1 - Search for views with names beginning with "(Exportable".
'-------------------------
Const PROMPT_FOR_CUSTOM_VIEW = 1
Const SEARCH_FOR_EXPORTABLE_VIEW
On Error Goto ErrorTrap
Set s = New Notessession
Set w = New NotesUIWorkspace
'Get Current View
Set db = s.CurrentDatabase
If w.CurrentView Is Nothing Then
Msgbox "Unable to export view because no view found. This may" & _
" occur if the current view is an embedded view.", 16, "Unable to Export"
Exit Sub
End If
Set view = w.CurrentView.View
'Set Mode
If sType = "All" Then iSelectedOnly = False
If sType = "Selected" Then
iSelectedOnly = True
Set dc = db.UnprocessedDocuments
End If
'Prompt User for type of export, or just use current view.
If PROMPT_FOR_CUSTOM_VIEW = 1 Then
arrReportTypes(0) = "Current View -- " & view.Name & Space(150) & "$$$" & "0"
arrReportTypes(1) = "Customized Export - future use" & Space(150) & "$$$" & "1"
vtResponse = w.Prompt(PROMPT_OKCANCELLI
" you like to perform?", "", arrReportTypes)
If Isempty(vtResponse) Then Exit Sub
Else
vtResponse = "Current View -- " & view.Name & Space(150) & "$$$" & "0"
End If
'Check type of report chosen
If Strrightback(vtResponse, "$$$") = "1" Then
'Custom Export
If SEARCH_FOR_EXPORTABLE_VIEW
'Figure out what view the user wants to export
Set view = PromptForView
If view Is Nothing Then Exit Sub
Else
'Get view by using the view section name as the view alias
'Section name is whatever is before the first \ character
'in the view's title.
Set view = db.GetView(Trim(Strleft(vi
If view Is Nothing Then
Msgbox "Sorry, this section is not yet setup for customization.", 16, "Export To Excel"
Exit Sub
End If
End If
'Get Array of All Columns, but exclude any columns
'that have a formula equal to "".
iCount = 0
For x = 0 To Ubound(view.Columns)
If IsUIColumn(view.Columns(x)
'Don't include this column
Else
'Include the column
Redim Preserve arrColumns(iCount)
Set arrColumns(iCount) = view.Columns(x)
iCount = iCount + 1
End If
Next
vtColumns = arrColumns
'Allow user to customize what columns are exported and in what order.
vtColumnOrder = CustomizeExport
If Isempty(vtColumnOrder) Then Exit Sub
'Get number of columns
iNumColumns = Ubound(vtColumnOrder) + 1
Else
'Current View Export
'Get Array of All Columns, but exclude any columns
'that have a formula equal to "".
iCount = 0
For x = 0 To Ubound(view.Columns)
If IsUIColumn(view.Columns(x)
'Don't include this column
Else
'Include the column
Redim Preserve arrColumns(iCount)
Set arrColumns(iCount) = view.Columns(x)
iCount = iCount + 1
End If
Next
vtColumns = arrColumns
'Get order that columns will be exported in
iCount = 0
For x = 0 To Ubound(vtColumns)
'Remove any hidden columns or columns that are icons
If Not (vtColumns(x).Ishidden Or vtColumns(x).IsIcon) Then
Redim Preserve arrColumnOrder(iCount)
arrColumnOrder(iCount) = x 'set to export column
iCount = iCount + 1
End If
Next
vtColumnOrder = arrColumnOrder
'Get number of columns
iNumColumns = Ubound(vtColumnOrder) + 1
'Disable sort
iSortBy = 0
End If
'Create Excel Object
Set excelApp = CreateObject("Excel.Applic
If excelApp Is Nothing Then
message$ = "Could not create spreadsheet." & Chr$( 10 ) & _
"Make sure Excel is installed on this computer."
Msgbox message$, 16, "Creation of Spreadsheet Object Failed"
Continue = False
Exit Sub
End If
'Prompt for Excel file location and save.
Set excelWkbks = excelApp.Workbooks
vtFileName = w.SaveFileDialog(False, "Choose New File", "Microsoft Excel|*.xls", "c:\windows\desktop")
If Isempty(vtFileName) Then Exit Sub
Set excelNewWkbk = excelWkbks.Add
Call excelNewWkbk.SaveAs(vtFile
Set excelSheet = excelNewWkbk.ActiveSheet
With excelNewWkbk
.Title = sViewName
End With
'Do Export
Call DoExport
'Tidy Up by making title row bold, setting columns to autofit,
'and running sort on all rows, if necessary.
Print "Tidying up spreadsheet..."
excelSheet.Range("1:1").Fo
excelSheet.Columns.AutoFit
excelSheet.Columns.WrapTex
excelSheet.Rows.VerticalAl
excelSheet.Rows.Horizontal
excelSheet.Rows.ShrinkToFi
'xlSheet.Rows(m).Rowheight
excelSheet.Rows.Rowheight = 50
excelSheet.pagesetup.LeftH
excelSheet.pagesetup.Right
excelSheet.pagesetup.Right
excelSheet.pagesetup.Print
excelSheet.pagesetup.LeftM
excelSheet.pagesetup.Right
excelSheet.pagesetup.Print
excelSheet.pagesetup.Cente
excelSheet.pagesetup.FitTo
excelSheet.pagesetup.Orien
If iSortBy <> 0 Then
'(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, _
'OrderCustom, MatchCase, Orientation, SortMethod)
Call excelSheet.UsedRange.Sort(
, , , XLYES)
End If
'Finish and give user option to open workbook.
Print "Saving spreadsheet..."
excelNewWkbk.Save
excelNewWkbk.Close
Print "Finished."
x = Msgbox("Would you like to Open the Excel Workbook Now?", 32 + 4, "Finished")
If x = 6 Then
sRun = excelApp.Path & "\excel.exe " & """" & vtFileName(0)& """"
'Msgbox sRun
taskID = Shell(sRun, 3)
End If
Print
Exit Sub
ErrorTrap:
Msgbox "ERROR on line " & Cstr(Erl) & " (" & Cstr(Err) & ") - " & Error$
If sErrorMsg <> "" Then
Msgbox sErrorMsg
End If
'Quit without saving document.
excelApp.DisplayAlerts = False
excelApp.Quit
Exit Sub
End Sub
Function IsUIColumn(vtTestColumn As Variant) As Integer
'-------------------------
' Function to return True/False whether column formula is considered
' a UI only one.
'
' The DoExport routine uses the ColumnValues property of the NotesViewEntry
' which does not return any values for columns with UI only formulas, such
' as @IsExpandable and @DocNumber
'
' We use the Columns property of the View to return all the columns in
' the view we are going to export. Mainly this is needed to gain access
' to the titles of the columns for the export, as well as being vital to
' allowing users to customize the export. Then, in script, we need to remove
' any columns that won't be returned by the ColumnValues property, by
' checking each in this function.
'
' In future version of Lotus Notes, Lotus may add new UI only functions
' which will need to be added to the list we check. That can be done by
' adding another element in the arrUIFormula array used below.
'-------------------------
IsUIColumn = False
Dim arrUIFormula(6) As String
Dim sTestFormula As String
Dim z As Integer
'List of UI formulas that won't be picked up by ColumnValues property
'as taken from Notes Designer Help document named
'"Formulas that look for values in columns and views"
arrUIFormula(0) = "@IsExpandable"
arrUIFormula(1) = "@DocNumber"
arrUIFormula(2) = "@DocChildren"
arrUIFormula(3) = "@DocDescendants"
arrUIFormula(4) = "@DocParentNumber"
arrUIFormula(5) = "@DocSiblings"
arrUIFormula(6) = "@IsCategory"
sTestFormula = vtTestColumn.Formula
'Test for any UI only formulas
For z = 0 To Ubound(arrUIFormula)
If Instr(1, sTestFormula, arrUIFormula(z), 5) <> 0 Then
'If we find a UI only formula in the column, exit the
'function and return true so the export script won't attempt
'to use that column.
IsUIColumn = True
Exit Function
End If
Next
'Test for a constant value that will be ignored by column search used by
'ColumnValues property.
If vtTestColumn.IsFormula And Instr(1, sTestFormula, "@", 5) = 0 And _
Instr(1, sTestFormula, "+", 5) = 0 Then
'Possibly is a constant-value column formula. If so, the ColumnValues
'property will ignore it.
'
'To avoid this, we tested that the column value is a formula, thus
'ruling out a field only column formula. Also, we tested for the
'existance of an @ symbol or a + symbol which should most of the time
'mean that the formula is not a constant-value. The only cases that
'are likely to result in true are cases where the column formula is
'equal to a single string, such as "String". In this case we'll set
'IsUIColumn to true because the ColumnValues property will ignore it.
'
'Likely the worst case is that the column is considered a UI only
'column and its title is not exported, but the data will still be
'exported in the DoExport routine because the ColumnValues property
'will return it. In that case, the titles in the spreadsheet will be
'skewed, but at least the application won't crash.
IsUIColumn = True
Exit Function
End If
End Function
I will also continue to work with it.
I know this is extensive, this is actually a canned script obtain from the sandbox.
Thank You !
Paul
Dim s As NotesSession
Dim db As NotesDatabase
Dim uidoc As NotesUIDocument
Dim dc As NotesDocumentCollection
Dim excelNewWkbk As Variant
Dim excelSheet As Variant
Dim excelApp As Variant
Dim filename As Variant
Dim aDataTable() As Variant
Dim vtViewList As Variant
Dim view As NotesView
Dim taskID As Integer
Dim sRun As String
Dim x As Integer
Dim y As Integer
Dim sViewName As String
Dim Message As String
Dim excelWkbks As Variant
Dim Continue As String
Dim vtColumnTypes As Variant
Dim columnCount As Integer
Dim lngVeCount As Long
Dim lngTotal As Long
Dim vn As NotesViewNavigator
Dim ve As NotesViewEntry
Dim vec As NotesViewEntryCollection
Dim sListName As String
Dim vtFileName As Variant
Dim arrExistingLists As Variant
Dim iNumColumns As Integer
Dim arrColumns() As Variant
Dim vtColumns As Variant
Dim doc As NotesDocument
Dim arrReportTypes(1) As String
Dim vtResponse As Variant
Dim vtDocumentSet As Variant
Dim arrExportViews() As String
Dim v As NotesView
Dim iCount As Integer
Dim arrColumnOrder() As Integer
Dim vtColumnOrder As Variant
Dim docCustomExport As NotesDocument
Dim arrColumnnames() As String
Dim iSortBy As Integer
Dim arrCellValues() As Variant
Dim docTest As NotesDocument
Dim iSelectedOnly As Integer
Dim vtColumnvalue As Variant
Dim iHasCategories As Integer
Dim sErrorMsg As String
'Excel Automation Constants
Const XLYES = 1
Sub UpdateStatusBar(x As Long, total As Long)
Print "Working..." & Cstr(Round((x / total), 2)*100) & "% done"
End Sub
'-------------------------
' Returns a variant that contains a 1 or 0 for each column
'
' 1 - the column is visible and should be exported.
' 0 - the column is hidden and should not be exported.
'-------------------------
Dim vtColumnTypes()
Dim iCount As Integer
Dim iNumColumns As Integer
iNumColumns = Ubound(view.Columns)
Redim vtColumnTypes(iNumColumns)
iCount = 0
Forall col In view.Columns
If col.Ishidden Or col.IsIcon Then
vtColumnTypes(iCount) = 0 'set to not export column
Else
vtColumnTypes(iCount) = 1 'set to export
End If
iCount = iCount + 1
End Forall
GetColumnTypes = vtColumnTypes()
End Function
Sub DoExport()
On Error Goto DoExportErrorTrap
On Error 9 Goto SubscriptOutOfRangeTrap
'-------------------------
' Subroutine that exports data from view to Excel.
'-------------------------
'Insert Titles
For x = 0 To iNumColumns - 1
excelSheet.Cells(1, x + 1).value = vtColumns(vtColumnOrder(x)
Next
'-------------------------
' Start export. Get total number of entries for use in
' UpdateStatusBar function.
'-------------------------
lngVeCount = 2 'First Document starts at row 2
Set vn = view.CreateViewNav
'Get total number of entries
Set ve = vn.GetFirst
If iSelectedOnly Then
lngTotal = dc.Count
Else
While Not (ve Is Nothing)
lngTotal = lngTotal + 1
Set ve = vn.GetNext(ve)
Wend
lngTotal = lngTotal - 1
End If
'-------------------------
' Loop through all entries. If we're in selected only mode, see
' if the current entry's document is part of the unprocessed
' documents collection. If it is not, just skip that entry.
' For all other cases, process the view entry as follows:
'
' If entry is a category, output only the category column value
' for that row.
' If entry is a document, output all columns except any columns
' that are categories
' Skip all Total or Conflict type view entries. (code could be
' added later)
'-------------------------
Set ve = vn.GetFirst
While Not (ve Is Nothing)
Call UpdateStatusBar(lngVeCount
If iSelectedOnly Then
Set docTest = Nothing 'reset test doc.
If ve.IsDocument Then
Set docTest = dc.GetDocument(ve.Document
End If
End If
If iSelectedOnly And docTest Is Nothing Then
'Do Nothing
Else
'Redimension array to hold next row (clear old values)
Redim arrCellValues(iNumColumns - 1)
Select Case True
Case ve.IsCategory
'Loop through possible multi-value category column
For x = 0 To Ubound(ve.ColumnValues)
'If column isn't part of the selected list of columns to export
'(from Custom export only), then skip that column. Otherwise
'add that column in the appropriate position.
If Not Isnull(Arraygetindex(vtCol
arrCellValues(Arraygetinde
End If
Next
'Export row to excel
excelSheet.Range(excelShee
excelSheet.Cells(lngVeCoun
Case ve.IsConflict
'skip
Case ve.IsTotal
'skip
Case ve.IsDocument
'Loop through all columns in view entry
For x = 0 To iNumColumns - 1
'If the column is a category then don't show the category in this row,
'unless we're in Selected Only mode. In Selected Only mode, we must
'show the category or the category value won't make it to the export.
If vtColumns(vtColumnOrder(x)
arrCellValues(x) = ""
Else
'Set column value to variant in case it is multi-value.
vtColumnValue = ve.ColumnValues(vtColumnOr
'If column has multi-values, concatenate all values before export.
If Isarray(vtColumnValue) Then
For y = 0 To Ubound(vtColumnValue)
arrCellValues(x) = arrCellValues(x) & vtColumnValue(y) & Chr(10)
Next
Else
arrCellValues(x) = vtColumnValue
End If
End If
Next
'Export row to excel.
excelSheet.Range(excelShee
excelSheet.Cells(lngVeCoun
End Select
'Update count of processed view entries.
lngVeCount = lngVeCount + 1
End If
Set ve = vn.GetNext(ve)
Wend
Exit Sub
DoExportErrorTrap:
Msgbox "ERROR on line " & Cstr(Erl) & " (" & Cstr(Err) & ") - " & Error$
Exit Sub
SubscriptOutOfRangeTrap:
Msgbox "ERROR on line " & Cstr(Erl) & " (" & Cstr(Err) & ") - " & Error$ & _
Chr(10) & Chr(10) & "This error is most likely to occur when a column being " & _
"exported has a formula that contains a constant value, such as a single " & _
"string. If you wish to export a constant value, you need to trick Notes " & _
"into thinking it is not a constant value by adding a dummy variable in your " & _
" formula, such as ""String"" + dummyvar."
Exit Sub
End Sub
Function PromptForView() As NotesView
'-------------------------
' Prompt user for choice of exportable views. Any view beginning
' with "(Exportable" in its title will be found. The alias of this
' view can be set to allow for a more presentable name of the view.
' For example, you might call the view "(Exportable Contacts)" with
' an alias of "Contacts". The word Contacts will appear to the user
' as the name of the customizable view.
'
' If no views are found, the script ends and the user is prompted
' to not choose Customizable view
'
' This script returns the NotesView chosen by the user.
'-------------------------
Set PromptForView = Nothing
Print "Finding Exportable Views..."
'Search database for customizable export views
iCount = 0
Forall v In db.Views
If Left(v.Name, 11) = "(Exportable" Then
Redim Preserve arrExportViews(iCount)
'Get alias name if it exists, otherwise use view title.
If Isempty(v.Aliases) Then
arrExportViews(iCount) = v.Name
Else
arrExportViews(iCount) = v.Aliases(0)
End If
iCount = iCount + 1
End If
End Forall
'If no views found, then explain to user.
If iCount = 0 Then
Msgbox "No Exportable Views Found. Please try again and do not choose Customize View"
Exit Function
End If
Print "Please choose a view."
'Prompt user for which view to export
vtResponse = w.Prompt(PROMPT_OKCANCELLI
" to perform a custom export?", "", arrExportViews)
If Isempty(vtResponse) Then Exit Function
Set PromptForView = db.GetView(vtResponse)
Print ""
End Function
Function CustomizeExport() As Variant
'-------------------------
' Presents user with a dialog box where he/she can choose what fields
' are going to be exported and in what order.
'
' The field names are taken from the name of each column in the view.
'-------------------------
'Create new doc for dialog box
Set docCustomExport = db.CreateDocument
'Load dialog box with column names and order
Redim arrColumnNames(Ubound(vtCo
For x = 0 To Ubound(vtColumns)
If vtColumns(x).Title = "" Then
arrColumnNames(x) = "Column" & Cstr(x) & Space(150) & "$$$" & Cstr(x)
Else
arrColumnNames(x) = vtColumns(x).Title & Space(150) & "$$$" & Cstr(x)
End If
Next
'Set Listbox Fields
docCustomExport.ExportSour
docCustomExport.ExportSele
'Display Dialog to allow users to choose columns, column order
'and sort order.
x = w.Dialogbox("(dlgCustomExp
"Choose Fields For Export", docCustomExport, False, False)
If x = False Then Exit Function
'Return Column Order
Dim arrColumnValues() As Integer
Redim arrColumnValues(Ubound(doc
For x = 0 To Ubound(arrColumnValues)
arrColumnValues(x) = Cint(docCustomExport.Expor
Next
'Check for categorized columns. If they exist, set flag to prevent
'sorting from occuring. Since categorized columns get exported to
'their own row, a sort will cause all the categories to sort to the
'bottom or top and they won't visually match up to the row they
'belong to.
iHasCategories = False
For x = 0 To Ubound(arrColumnValues)
If vtColumns(arrColumnValues(
iHasCategories = True
End If
Next
'Assign sort column number if appropriate and exit function
If Not iHasCategories Then
iSortBy = Cint(Arraygetindex(docCust
End If
CustomizeExport = arrColumnValues
End Function
Sub ExportViewToExcel(sType As String)
'-------------------------
' Main script for exporting a view to Excel.
'
' The script determines the mode selected. It can either be all
' documents in view, or just selected documents. Then the user
' may be prompted to export the current view or a customized view.
' You can turn off that prompt using the PROMPT_FOR_CUSTOM_VIEW
' constant found below.
'
' Once the view is chosen, the script determines the view column
' order. It skips hidden columns, response columns, and columns
' with formulas equal to "". If customizable view is chosen, the
' user can select which columns to export, the order to export them,
' and what sort order they're given.
'-------------------------
'-------------------------
' Constants below allow developer to toggle prompt for customized
' view and search for exportable views in database.
'
' PROMPT_FOR_CUSTOM_VIEW:
' 0 - Do not prompt user to export customized view.
' 1 - Prompt user with choice to export customized view or current
' view. If customized view is chosen, then search for views
' depending on SEARCH_FOR_EXPORTABLE_VIEW
'
' SEARCH_FOR_EXPORTABLE_VIEW
' 0 - Do not search for views with names beginning with "(Exportable".
' Instead, if customized is chosen, the current view's name will
' be used to find the custom view to use. If the current view's name
' is, for example, Contacts \ By Name, then the script will look for
' a view named Contacts. This is useful if you want to have custom
' views for sets of related views.
' 1 - Search for views with names beginning with "(Exportable".
'-------------------------
Const PROMPT_FOR_CUSTOM_VIEW = 1
Const SEARCH_FOR_EXPORTABLE_VIEW
On Error Goto ErrorTrap
Set s = New Notessession
Set w = New NotesUIWorkspace
'Get Current View
Set db = s.CurrentDatabase
If w.CurrentView Is Nothing Then
Msgbox "Unable to export view because no view found. This may" & _
" occur if the current view is an embedded view.", 16, "Unable to Export"
Exit Sub
End If
Set view = w.CurrentView.View
'Set Mode
If sType = "All" Then iSelectedOnly = False
If sType = "Selected" Then
iSelectedOnly = True
Set dc = db.UnprocessedDocuments
End If
'Prompt User for type of export, or just use current view.
If PROMPT_FOR_CUSTOM_VIEW = 1 Then
arrReportTypes(0) = "Current View -- " & view.Name & Space(150) & "$$$" & "0"
arrReportTypes(1) = "Customized Export - future use" & Space(150) & "$$$" & "1"
vtResponse = w.Prompt(PROMPT_OKCANCELLI
" you like to perform?", "", arrReportTypes)
If Isempty(vtResponse) Then Exit Sub
Else
vtResponse = "Current View -- " & view.Name & Space(150) & "$$$" & "0"
End If
'Check type of report chosen
If Strrightback(vtResponse, "$$$") = "1" Then
'Custom Export
If SEARCH_FOR_EXPORTABLE_VIEW
'Figure out what view the user wants to export
Set view = PromptForView
If view Is Nothing Then Exit Sub
Else
'Get view by using the view section name as the view alias
'Section name is whatever is before the first \ character
'in the view's title.
Set view = db.GetView(Trim(Strleft(vi
If view Is Nothing Then
Msgbox "Sorry, this section is not yet setup for customization.", 16, "Export To Excel"
Exit Sub
End If
End If
'Get Array of All Columns, but exclude any columns
'that have a formula equal to "".
iCount = 0
For x = 0 To Ubound(view.Columns)
If IsUIColumn(view.Columns(x)
'Don't include this column
Else
'Include the column
Redim Preserve arrColumns(iCount)
Set arrColumns(iCount) = view.Columns(x)
iCount = iCount + 1
End If
Next
vtColumns = arrColumns
'Allow user to customize what columns are exported and in what order.
vtColumnOrder = CustomizeExport
If Isempty(vtColumnOrder) Then Exit Sub
'Get number of columns
iNumColumns = Ubound(vtColumnOrder) + 1
Else
'Current View Export
'Get Array of All Columns, but exclude any columns
'that have a formula equal to "".
iCount = 0
For x = 0 To Ubound(view.Columns)
If IsUIColumn(view.Columns(x)
'Don't include this column
Else
'Include the column
Redim Preserve arrColumns(iCount)
Set arrColumns(iCount) = view.Columns(x)
iCount = iCount + 1
End If
Next
vtColumns = arrColumns
'Get order that columns will be exported in
iCount = 0
For x = 0 To Ubound(vtColumns)
'Remove any hidden columns or columns that are icons
If Not (vtColumns(x).Ishidden Or vtColumns(x).IsIcon) Then
Redim Preserve arrColumnOrder(iCount)
arrColumnOrder(iCount) = x 'set to export column
iCount = iCount + 1
End If
Next
vtColumnOrder = arrColumnOrder
'Get number of columns
iNumColumns = Ubound(vtColumnOrder) + 1
'Disable sort
iSortBy = 0
End If
'Create Excel Object
Set excelApp = CreateObject("Excel.Applic
If excelApp Is Nothing Then
message$ = "Could not create spreadsheet." & Chr$( 10 ) & _
"Make sure Excel is installed on this computer."
Msgbox message$, 16, "Creation of Spreadsheet Object Failed"
Continue = False
Exit Sub
End If
'Prompt for Excel file location and save.
Set excelWkbks = excelApp.Workbooks
vtFileName = w.SaveFileDialog(False, "Choose New File", "Microsoft Excel|*.xls", "c:\windows\desktop")
If Isempty(vtFileName) Then Exit Sub
Set excelNewWkbk = excelWkbks.Add
Call excelNewWkbk.SaveAs(vtFile
Set excelSheet = excelNewWkbk.ActiveSheet
With excelNewWkbk
.Title = sViewName
End With
'Do Export
Call DoExport
'Tidy Up by making title row bold, setting columns to autofit,
'and running sort on all rows, if necessary.
Print "Tidying up spreadsheet..."
excelSheet.Range("1:1").Fo
excelSheet.Columns.AutoFit
excelSheet.Columns.WrapTex
excelSheet.Rows.VerticalAl
excelSheet.Rows.Horizontal
excelSheet.Rows.ShrinkToFi
'xlSheet.Rows(m).Rowheight
excelSheet.Rows.Rowheight = 50
excelSheet.pagesetup.LeftH
excelSheet.pagesetup.Right
excelSheet.pagesetup.Right
excelSheet.pagesetup.Print
excelSheet.pagesetup.LeftM
excelSheet.pagesetup.Right
excelSheet.pagesetup.Print
excelSheet.pagesetup.Cente
excelSheet.pagesetup.FitTo
excelSheet.pagesetup.Orien
If iSortBy <> 0 Then
'(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, _
'OrderCustom, MatchCase, Orientation, SortMethod)
Call excelSheet.UsedRange.Sort(
, , , XLYES)
End If
'Finish and give user option to open workbook.
Print "Saving spreadsheet..."
excelNewWkbk.Save
excelNewWkbk.Close
Print "Finished."
x = Msgbox("Would you like to Open the Excel Workbook Now?", 32 + 4, "Finished")
If x = 6 Then
sRun = excelApp.Path & "\excel.exe " & """" & vtFileName(0)& """"
'Msgbox sRun
taskID = Shell(sRun, 3)
End If
Exit Sub
ErrorTrap:
Msgbox "ERROR on line " & Cstr(Erl) & " (" & Cstr(Err) & ") - " & Error$
If sErrorMsg <> "" Then
Msgbox sErrorMsg
End If
'Quit without saving document.
excelApp.DisplayAlerts = False
excelApp.Quit
Exit Sub
End Sub
Function IsUIColumn(vtTestColumn As Variant) As Integer
'-------------------------
' Function to return True/False whether column formula is considered
' a UI only one.
'
' The DoExport routine uses the ColumnValues property of the NotesViewEntry
' which does not return any values for columns with UI only formulas, such
' as @IsExpandable and @DocNumber
'
' We use the Columns property of the View to return all the columns in
' the view we are going to export. Mainly this is needed to gain access
' to the titles of the columns for the export, as well as being vital to
' allowing users to customize the export. Then, in script, we need to remove
' any columns that won't be returned by the ColumnValues property, by
' checking each in this function.
'
' In future version of Lotus Notes, Lotus may add new UI only functions
' which will need to be added to the list we check. That can be done by
' adding another element in the arrUIFormula array used below.
'-------------------------
IsUIColumn = False
Dim arrUIFormula(6) As String
Dim sTestFormula As String
Dim z As Integer
'List of UI formulas that won't be picked up by ColumnValues property
'as taken from Notes Designer Help document named
'"Formulas that look for values in columns and views"
arrUIFormula(0) = "@IsExpandable"
arrUIFormula(1) = "@DocNumber"
arrUIFormula(2) = "@DocChildren"
arrUIFormula(3) = "@DocDescendants"
arrUIFormula(4) = "@DocParentNumber"
arrUIFormula(5) = "@DocSiblings"
arrUIFormula(6) = "@IsCategory"
sTestFormula = vtTestColumn.Formula
'Test for any UI only formulas
For z = 0 To Ubound(arrUIFormula)
If Instr(1, sTestFormula, arrUIFormula(z), 5) <> 0 Then
'If we find a UI only formula in the column, exit the
'function and return true so the export script won't attempt
'to use that column.
IsUIColumn = True
Exit Function
End If
Next
'Test for a constant value that will be ignored by column search used by
'ColumnValues property.
If vtTestColumn.IsFormula And Instr(1, sTestFormula, "@", 5) = 0 And _
Instr(1, sTestFormula, "+", 5) = 0 Then
'Possibly is a constant-value column formula. If so, the ColumnValues
'property will ignore it.
'
'To avoid this, we tested that the column value is a formula, thus
'ruling out a field only column formula. Also, we tested for the
'existance of an @ symbol or a + symbol which should most of the time
'mean that the formula is not a constant-value. The only cases that
'are likely to result in true are cases where the column formula is
'equal to a single string, such as "String". In this case we'll set
'IsUIColumn to true because the ColumnValues property will ignore it.
'
'Likely the worst case is that the column is considered a UI only
'column and its title is not exported, but the data will still be
'exported in the DoExport routine because the ColumnValues property
'will return it. In that case, the titles in the spreadsheet will be
'skewed, but at least the application won't crash.
IsUIColumn = True
Exit Function
End If
End Function
I will also continue to work with it.
I know this is extensive, this is actually a canned script obtain from the sandbox.
Thank You !
Paul
OMG! I am scared... lol. Oh well, Hemantha! Where are you? Come lets help Paul out ;-) YOu want points for this thread, don't you ;-)
Paul, one more hint ;-) Add the code in the DoExport function. I couyldn't make out your P1 and P2 thing, hence no further progress.
Paul, one more hint ;-) Add the code in the DoExport function. I couyldn't make out your P1 and P2 thing, hence no further progress.
Object Management Group ?? Why are you scared of them ???
Yes I need points.. but you were the one who asked for code.. so enjoy the code and I will enjoy the points.. iBTW, t is too big to walk thru.
Let me try... if I have time to.
Yes I need points.. but you were the one who asked for code.. so enjoy the code and I will enjoy the points.. iBTW, t is too big to walk thru.
Let me try... if I have time to.
hai,
i am trying to count number of pages in a excelsheet.
this is my code
Private Sub Command1_Click()
On Error GoTo ErrCom
Set oexcel = CreateObject("Excel.Applic
oexcel.Visible = False
'oexcel.ActiveWindow.View = xlPageBreakPreview
Set oxls = oexcel.Workbooks.Open(file
Dim i As Integer
oexcel.ActiveWindow.view = xlNormalView
oexcel.ActiveWindow.view = xlPageBreakPreview
For i = 1 To oexcel.Worksheets.Count
iHPageB = oexcel.Worksheets(i).HPage
iVpageB = oexcel.Worksheets(i).VPage
Next
MsgBox iHPageB * iVpageB
oxls.Worksheets.Select
oxls.Application.Workbooks
ErrEnd:
Exit Sub
ErrCom:
MsgBox Err.Number & Err.Description, vbInformation, "Excel Application"
Resume ErrEnd
Resume 0
End Sub
here in this code i am trying to find the number of horzontal pagebreaks and the number of vertical pagebreaks and the result i am producting and getting the page count but it is not correct count number of pages in the excel sheet. if any one knows it please help me how the page count can be found.
please help me........................
i am trying to count number of pages in a excelsheet.
this is my code
Private Sub Command1_Click()
On Error GoTo ErrCom
Set oexcel = CreateObject("Excel.Applic
oexcel.Visible = False
'oexcel.ActiveWindow.View = xlPageBreakPreview
Set oxls = oexcel.Workbooks.Open(file
Dim i As Integer
oexcel.ActiveWindow.view = xlNormalView
oexcel.ActiveWindow.view = xlPageBreakPreview
For i = 1 To oexcel.Worksheets.Count
iHPageB = oexcel.Worksheets(i).HPage
iVpageB = oexcel.Worksheets(i).VPage
Next
MsgBox iHPageB * iVpageB
oxls.Worksheets.Select
oxls.Application.Workbooks
ErrEnd:
Exit Sub
ErrCom:
MsgBox Err.Number & Err.Description, vbInformation, "Excel Application"
Resume ErrEnd
Resume 0
End Sub
here in this code i am trying to find the number of horzontal pagebreaks and the number of vertical pagebreaks and the result i am producting and getting the page count but it is not correct count number of pages in the excel sheet. if any one knows it please help me how the page count can be found.
please help me........................
ASKER
I came up with a work around so I really didn't need this anymore, however I do appreciate the assistance I get.
Hemanth, Thank you !
Paul
Of course, Ranjeet... Thank you too !
Hemanth, Thank you !
Paul
Of course, Ranjeet... Thank you too !
Long time!!!
I must say you have become a miser, lol. Okay, jokes apart, tell me what do you want exactly. Post your code here and state clearly your need. I will modify your code accordingly.