RE: Export to Excel for Categorized view thru LS The Capable 17.May.11 11:40 AM a Web browser Applications Development All ReleasesWindows 2000
Well Finner!
I wasn't looking for stupid advices but some concrete assistance. Anyway I could code it on my own and here is the logic:
(Action) Excel to Excel
Dim ws As NotesUIWorkspace
Dim uiview As NotesUIView
Dim view As NotesView
Dim nav As NotesViewNavigator
Dim entrya As NotesViewEntry
Dim thisdoc As NotesDocument
Dim response As Variant
Dim values(1) As Variant
Dim excel As Variant
Dim excelWorkbook As Variant
Dim excelSheet As Variant
Dim row, col As Integer
Sub Click(Source As Button)
'Trap any errors that occur:
On Error Goto ErrorTrap
Set ws=New NotesUIWorkspace
'Get handle on current view:
Set uiview = ws.CurrentView
Set view = uiview.View
view.AutoUpdate = False
'Exit if there are no documents in view:
If (view.AllEntries.Count = 0) Then
Msgbox "No Entries in the view",16,"Export to Excel"
Exit Sub
End If
'Create excel object:
Set excel = CreateObject("Excel.Application")
'Create excel workbook:
Set excelWorkbook = excel.Workbooks.Add
'Create excel sheet:
Set excelSheet = excelWorkbook.Sheets(1)
'Format excel data:
excel.Cells.select
excel.Selection.Font.Name = "Arial"
excel.Selection.Font.Size = 8
excel.Selection.ColumnWidth = 10
excel.Selection.WrapText = False
'Format excel headers:
excel.Rows("1:1").Select
excel.Selection.Font.Bold = True
'Set colum counter:
col = 1
'Set row counter:
row = 1
'Add column headers:
Forall column In view.Columns
excelSheet.Cells(row, col).value = column.Title
col = col + 1
End Forall
row = row + 1
values(0) = "SingleCategory"
values(1) = "AllCategories"
response = ws.Prompt (PROMPT_OKCANCELCOMBO, "Select a type", "Select a type to Export.", values(0), values)
If Isempty (response) Then
Messagebox "User canceled", , "Export to Excel"
Exit Sub
End If
If response="SingleCategory" Then
'Call Singlecat() ' Need ot complete it
Else
Call AllCat()
End If
'Display file:
excel.ActiveSheet.Range("A1").Select
excel.Visible = True
excelSheet.Range("R2:S4").Select
excel.Charts.Add
'excelSheet.ActiveChart.ChartType = xl3DPie
xlChartType = -4102 'code of 3DPie chart
xlLocationAsObject = 2
With excel.ActiveWorkbook.ActiveChart
.Name = "Type of Documents"
.ChartType = -4102 'code of 3DPie chart
.Location 2, "Sheet1" 'move chart to worksheet
End With
excel.ActiveSheet.ChartObjects("Chart 1").Activate
excel.ActiveChart.ChartArea.Select 'select chart
'The below lines between With - End WIth doesn't work in the above block, I guess the Chart should be selected to set the below properties
Dim ochart, oseries, olabel As Variant
Set ochart=excel.ActiveWorkbook.ActiveChart
'http://vbcity.com/forums/t/81102.aspx
With ochart
.HasTitle = True
.ChartTitle.Characters.Text = "Data Distribution"
End With
ochart.SeriesCollection(1).HasDataLabels = True
oChart.HasLegend = True
excel.ActiveSheet.Shapes("Chart 1").IncrementLeft -750
excel.ActiveSheet.Shapes("Chart 1").IncrementTop 140
excel.ActiveSheet.Shapes("Chart 1").ScaleWidth 0.7, msoFalse,msoScaleFromTopLeft 'change chart dimensions
excel.ActiveSheet.Shapes("Chart 1").ScaleHeight 0.7, msoFalse, msoScaleFromBottomRight
excel.ActiveSheet.Range("A1").Select
'Call method to recycle objects:
Goto RecycleObjects
Exit Sub
'Method used to recycle objects:
RecycleObjects:
Set excelSheet = Nothing
Set excelWorkbook = Nothing
Set excel = Nothing
Set view = Nothing
Set uiview = Nothing
Exit Sub
'Method used to handle any errors:
ErrorTrap:
Msgbox "Unable to export file due to the following error:" & Chr(10) & Chr(10) & "ERROR on line " & Cstr(Erl) & " (" & Cstr(Err) & ") - " & Error$, 16, "Export to Excel - Click"
If Not (excel Is Nothing) Then
excel.ActiveSheet.Range("A1").Select
excel.Visible = True
End If
Goto RecycleObjects
Exit Sub
End Sub
Sub Firstlogic
Dim counter As Integer
Dim countername As String
counter=0
While Not entrya Is Nothing
col = 1
'Loop thru column values:
Forall column In entrya.ColumnValues
If col= 3 Then countername = columnValue
'Get column value:
If Isarray(column) Then
columnValue = Fulltrim(Join(column))
Else
columnValue = column
End If
'Add entry to excel:
excelSheet.Cells(row, col).value = columnValue
'Update column counter:
col = col + 1
End Forall
row = row + 1
If entrya.IsDocument Then counter=counter+1
Set entrya=nav.GetNext(entrya)
Wend
excelSheet.Cells(row-1, col+10).value = countername
excelSheet.Cells(row-1, col+11).value = counter
End Sub
Sub SingleCat
values(0) = "India"
values(1) = "US"
response = ws.Prompt (PROMPT_OKCANCELCOMBO, "Select a category", "Select a category to Export.", values(0), values)
If Isempty (response) Then
Messagebox "User canceled", , "Export to Excel"
Exit Sub
End If
Set nav =view.CreateViewNavFromCategory(response)
Set entrya=nav.GetFirst
Call firstlogic()
End Sub
Sub AllCat
'Trap any errors that occur:
On Error Goto ErrorTrap
Dim counter As Integer
Dim countername As String
Dim entryb As NotesViewEntry
Dim PieChartrow As Integer
PieChartrow=2
counter=0
Set nav =view.CreateViewNav()
Set entrya=nav.GetFirst
While Not entrya Is Nothing
col = 1
'Loop thru column values:
Forall column In entrya.ColumnValues
If col= 3 Then countername = columnValue
'Get column value:
If Isarray(column) Then
columnValue = Fulltrim(Join(column))
Else
columnValue = column
End If
'Add entry to excel:
If entrya.IsCategory Then
If col = 1 Then
excelSheet.Cells(row, 1).value = columnValue
Elseif col =2 Then
excelSheet.Cells(row, 2).value = columnValue
End If
End If
If col>2 Then
excelSheet.Cells(row, col).value = columnValue
End If
'Update column counter:
col = col + 1
End Forall
row = row + 1
If entrya.IsDocument Then counter=counter+1
Set entryb=entrya
Set entrya=nav.GetNext(entrya)
If Not entrya Is Nothing Then
If entryb.IsDocument And entrya.IsCategory Then
excelSheet.Cells(PieChartrow, col+10).value = countername
excelSheet.Cells(PieChartrow, col+11).value = counter
counter=0
PieChartrow=PieChartrow+1
End If
Else
excelSheet.Cells(PieChartrow, col+10).value = countername
excelSheet.Cells(PieChartrow, col+11).value = counter
End If
Wend
Exit Sub
'Method used to handle any errors:
ErrorTrap:
Msgbox "Unable to export file due to the following error:" & Chr(10) & Chr(10) & "ERROR on line " & Cstr(Erl) & " (" & Cstr(Err) & ") - " & Error$, 16, "Export to Excel"
If Not (excel Is Nothing) Then
excel.ActiveSheet.Range("A1").Select
excel.Visible = True
End If
Exit Sub
End Sub
Return to top
. . . . . . . . RE: Export to Excel for Categorized... (The Capable 17.May.11) 
Print this page
