il export la vue courante
- il n'exporte pas les colonnes caché, les colonnes de type icone, les colonne de type compteur (c'est à dire de formule "1")
il gère en plus
- les catégories multiple, c'est à dire les catégorie contenant des \ qui crée des sous catégories dans la vue
- les entrées multiple par catégorie (quand un document se retrouve plusieurs fois sous deux catégories différente)
- les colonnes constante
pour l'utilisation :
il faut mettre ce code dans un agent de type lotus-script
et exécuter l'agent en étant dans une vue
en espérant que cela serve a quelqu'un un jour
- Code : Tout sélectionner
%REM
Agent Export CurrentView
Created Nov 29, 2011 by Laurent Song
Description: Comments for Agent
%END REM
Option Public
Option Declare
Sub Initialize
Dim Session As New NotesSession
Dim db As NotesDatabase
Dim entry As NotesViewEntry
Dim ColVals As Variant
Dim LColIndex List As Integer ' liste des index des colonne dans excel : cela permet d'ajouter des colonnes en cas de catégorie multiple
Dim LColCat List As Integer ' Liste des catégories avec le nombre de niveaux
Dim LColSortAsc List As Boolean ' Sens du tris sur les colonnes catégorisées
Dim rows As Integer
Dim cols As Integer
Dim ColumnValues () As variant
Dim LConstant List As string
Dim LCatMultiContent List As String
Dim VCat As Variant
Dim delta As Integer
Dim maxcols As Integer
Dim WS As New NotesUIWorkspace
Dim Scope As String
Dim C As NotesViewColumn
Dim K As Integer
Dim xlApp As Variant
Dim xlsheet As Variant
Dim vwNav As NotesViewNavigator
Dim tmp As String
Dim dataview As NotesView
'***** Vous pouvez modifier le code pour qu'il fasse appel à une autre base de document
Set db = session.CurrentDatabase
Set dataview = WS.Currentview.View ' Ouvre la vue courrante
Set vwnav= dataview.createViewnav()
rows = 1
cols = 1
maxcols=dataview.ColumnCount ' Récupère le nombre de colonne
' initialisation de toutes les listes
Call init(LColIndex, LColCat, LColSortAsc, LConstant, maxcols, dataview)
Set xlApp = CreateObject("Excel.Application")' Lance Excel
Print "Création du tableau. Veuillez patienter..."
xlApp.Workbooks.Add
xlApp.ReferenceStyle = 2
Set xlsheet = xlApp.Workbooks(1).Worksheets(1) ' On prend la première feuille du classeur
' On met le titre de la vue
xlsheet.Cells(rows,cols).Value ="Vue : " + dataview.Name + ", de la base : " + db.title +", extraction du : " + Format(Now,"mm/dd/yyyy HH:MM")
Print "Création des entêtes de colonnes. Veuillez patienter..."
rows=2 ' On commence à la deuxième ligne : les titres des colonnes
For K=1 To maxcols
Set c=dataview.columns(K-1)
If c.Ishidden = False and c.Isicon = False And c.Formula <> "1" Then
xlsheet.Cells(rows,cols).Value = c.title
cols = cols + 1
End If
Next K
Set entry=vwnav.GetFirstDocument
rows=3 ' On se place sur la troisième ligne : debut des données
ReDim ColumnValues (maxcols) As variant
Do While Not (entry Is Nothing)
' il faut recomposer le tableau avec les colonnes constante, le tableau ColumnValues contient le resulat
Call RecomposeData (LConstant, ColumnValues, entry)
' ecriture des colonnes
For cols=0 To maxcols-1
colvals=ColumnValues(cols)
scope=TypeName(colvals)
If LColIndex(cols) >=0 Then ' si on doit l'ecrire :
If IsElement (LColCat (cols)) Then ' si c'est une categorie
' Cas des categorie multiple
' on va crée une list d'ID avec les element Par unid
If IsArray (colvals) Then
If IsElement (LCatMultiContent (entry.Universalid)) Then
' ce n'est pas le premire fois que l'on trouve cette entrée on va reprendre la liste qu'il reste
colvals = Split (LCatMultiContent (entry.Universalid), "§¤")
Else
' C'est la premiere fois que l'on rencontre ce document, on va le trié
Call SortBubble (colvals)
End If
' Selon l'ordre de trie
If LColSortAsc(cols) Then
tmp = colvals (0) ' on prend le premier
colvals (0) = ""
If UBound (colvals) = 0 Then
Erase LCatMultiContent (entry.Universalid)
Else
LCatMultiContent (entry.Universalid)= Implode (colvals, "§¤")
LCatMultiContent (entry.Universalid)= Right (LCatMultiContent (entry.Universalid), Len (LCatMultiContent (entry.Universalid))-2)
End If
Else
tmp = colvals (UBound (colvals))
colvals (UBound (colvals)) = ""
If UBound (colvals) = 0 Then
Erase LCatMultiContent (entry.Universalid)
Else
LCatMultiContent (entry.Universalid)= Implode (colvals, "§¤")
LCatMultiContent (entry.Universalid)= Left (LCatMultiContent (entry.Universalid), Len (LCatMultiContent (entry.Universalid))-2)
End If
End If
colvals = tmp
End If
' c'est une categorie avec x elements
If InStr (colvals, "\") > 0 Then
VCat = Split (colvals, "\")
If UBound (Vcat) > LColCat (cols) Then
' ajouter les colones necessaire au fichier excel
While UBound (Vcat) > LColCat (cols)
xlsheet.Columns(cols+LColCat (cols)).Select
Call xlApp.Selection.EntireColumn.Insert
LColCat (cols) = LColCat (cols) + 1
Wend
' decaler l'index en consequance
Dim subcols As Integer
For subcols=cols To maxcols
LColIndex (subcols+1) = LColIndex (subcols+1) + LColCat (cols)
Next
End If
delta = 0
' remplissage
ForAll Ecat In Vcat
xlsheet.Cells(rows,LColIndex(cols)+delta).Value ="'" + Ecat
delta = delta+1
End ForAll
Else
xlsheet.Cells(rows,LColIndex(cols)).Value ="'" + colvals
End If
Else
' Cas des colonne normal
If IsArray (colvals) Then 's'il y a plusieurs element dans la ligne
colvals = Implode (colvals, " ")
End If
Select Case scope
Case "STRING"
xlsheet.Cells(rows,LColIndex(cols)).Value ="'" + colvals
Case Else
xlsheet.Cells(rows,LColIndex(cols)).Value = colvals
End Select
End If
End If
Next cols
Print "Import des données - Document " & rows-1
rows=rows+1
Set entry = vwnav.getnextdocument(entry)
Loop
' mise en page du document excel
xlApp.Rows("1:1").Select
xlApp.Selection.Font.Bold = True
xlApp.Selection.Font.Underline = True
xlApp.Rows("2:2").Select
xlApp.Selection.Font.Bold = True
xlApp.Selection.Font.Name = "Arial"
xlApp.Selection.Font.Size = 8
xlApp.Range(xlsheet.Cells(3,1), xlsheet.Cells(rows,maxcols)).Select
xlApp.Selection.Font.Name = "Arial"
xlApp.Selection.Font.Size = 8
xlApp.Selection.Columns.AutoFit
With xlApp.Worksheets(1)
.PageSetup.Orientation = 2
.PageSetup.centerheader = "Rapport"
.Pagesetup.RightFooter = "Page &P" & Chr$(13) & "Date : &D"
.Pagesetup.CenterFooter = ""
End With
xlApp.ReferenceStyle = 1
xlApp.Rows("3:3").Select
xlApp.ActiveWindow.FreezePanes = True
xlApp.Range("A1").Select
xlApp.Visible = True
print "L'import des données de la vue est terminé."
dataview.clear
Set xlapp=Nothing ' Stop l'automation excel
Set db=Nothing
End Sub
%REM
Sub index
Description: Comments for Sub
%END REM
Sub init (LColIndex List As Integer, LColCat List As Integer, LColSortAsc List As Boolean, LConstant List As String, max As Integer, dataview As NotesView)
Dim i As Integer
Dim K As Integer
Dim L As Integer
Dim c As NotesViewColumn
For i = 0 To max-1
LColIndex(i) = i+1
Next
For K=0 To max-1
Set c=dataview.columns(K)
If c.Iscategory Then
LColCat (K) = 0
If c.Issortdescending Then
LColSortAsc(K) = False
Else
LColSortAsc(K) = True
End If
End If
If c.Ishidden Or c.Isicon Or c.formula = "1" Then
LColIndex(K) = -1000
For L=K+1 To max-1
LColIndex(L) = LColIndex(L) -1
Next
End If
If c.Isconstant Then
' on va noter ou elle est
LConstant (K) = c.Formula
End If
Next
End Sub
%REM
Sub RecomposeData
Description: Comments for Sub
%END REM
Sub RecomposeData (LConstant List As String, ColumnValues () As variant, entry As NotesViewEntry)
Dim i As Integer
i = 0
ForAll elemColVal In entry.ColumnValues
While IsElement (LConstant(i))
ColumnValues (i) = LConstant(i)
i = i + 1
Wend
ColumnValues (i) = elemColVal
i = i + 1
End ForAll
End Sub
Sub SortBubble(vrTable As Variant)
'Tri à bulle par ordre croissant
'Déclaration Variables
Dim nbUBound As Long
Dim nbLbound As Long
Dim i As Long
Dim J As Long
Dim vrValue As Variant
On Error GoTo ErreurHandle
nbLbound = LBound(vrTable)
nbUBound = UBound(vrTable)
If nbUBound = nbLbound Then
'si 1 seule donnée pas de traitement
Exit Sub
ElseIf nbUBound = (nbLbound+1) Then
'si uniquement 2 données
If vrTable(nbLbound) > vrTable(nbUBound) Then
vrValue = vrTable(nbUBound)
vrTable(nbUBound) = vrTable(nbLbound)
vrTable(nbLbound) = vrValue
vrValue = Null
End If
Exit Sub
End If
'Tri du tableau
For i=nbLbound To nbUBound-1
J = i
While (J>=i)
If vrTable(J+1) < vrTable(J) Then
vrValue = vrTable(J)
vrTable(J) = vrTable(J+1)
vrTable(J+1) = vrValue
End If
J = J-1
Wend
Next
vrValue = Null
Exit Sub
ErreurHandle:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Exit Sub
End Sub