DominoArea.org [Archive]

A partir des codes Maillard/Raziel (merci à eux) j'ai complété le code de La solution Raillard pour permettre de choisir les colonnes exportées (Raziel)ub Initialize Dim Session As New NotesSession Dim db As NotesDatabase Dim sourceview As NotesView Dim sourcedoc As NotesDocument Dim dataview As NotesView Dim dc As NotesDocumentCollection Dim datadoc As NotesDocument Dim maxcols As Integer Dim WS As New Notesuiworkspace Dim ViewString As String Dim Scope As String Dim GetField As Variant Dim C As NotesViewColumn Dim FieldName As String Dim K As Integer Dim N As Integer Dim xlApp As Variant Dim xlsheet As Variant Dim rows As Integer Dim cols As Integer Dim nitem As NotesItem Dim entry As NotesViewEntry Dim vwNav As NotesViewNavigator Dim ShowView() As Variant Dim i As Integer Dim VList As Variant Dim ColVals As Variant '***********Variables pour choisir les colonnes à exporter vers excel Dim NomCol() As String Dim TabCol As Variant Dim Indice As Integer Dim ligne As Integer '***** *****Vous pouvez modifier le code pour qu'il fasse appel à une autre base de document Set db = session.CurrentDatabase Vlist= db.views ' Récupère les vue de la base K=Ubound(Vlist) ' Récupère le nombre de vue Redim Preserve ShowView(K) N=-1 For i = 0 To K If Len(Vlist(i).Name) >0 Then FieldName=Trim(Vlist(i).Name) If Mid(Fieldname,1,1) <>"(" Then ' On n'affiche pas les vues caché N=N+1 ShowView(N) = FieldName End If End If Next i Redim Preserve ShowView(N) ' ************Trie les vues par ordre alphabétique For i=0 To N For K=i To N If ShowView(i) > ShowView(k) Then FieldName=ShowView(i) ShowView(i) = ShowView(k) ShowView(k)=FieldName End If Next k Next i '****************Boite de dialogue pour choisir une vue viewstring= ws.Prompt(PROMPT_OKCANCELLIST,"Liste des vues","Choisissez une vue","",ShowView ) If Len(viewstring)=0 Then Exit Sub Set dataview = db.getview(ViewString) ' Ouvre la vue Set vwnav= dataview.createViewnav() rows = 1 cols = 1 maxcols=dataview.ColumnCount ' Récupère le nombre de colonne '*****************Choisir les colonnes à exporter vers excel Redim NomCol(Ubound(dataview.Columns)) As String 'Redim NomCol(Ubound(Vue.Columns)) As String Indice = 0 Forall Colonne In dataview.Columns If Colonne.Title <> "" And Colonne.IsHidden = False Then NomCol(indice) = Colonne.Title + "|" + Str$(Indice) Indice = Indice + 1 End Forall TabCol = ws.Prompt(PROMPT_OKCANCELLISTMULT, "Exportation vers Excel", _ "Sélectionnez les colonnes à exporter","" , Fulltrim(NomCol)) If Not Isempty(TabCol) Then For indice = 0 To Ubound(TabCol) TabCol(Indice) = Trim(Right(TabCol(Indice), 2)) Next End If '********************Ouverture d'une feuille excel Set xlApp = CreateObject("Excel.Application")' Lance Excel xlApp.StatusBar = "Création du tableau. Veuillez patienter..." xlApp.Visible = True 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 : " + ViewString + ", de la base : " + db.title +", extraction du : " + Format(Now,"mm/dd/yyyy HH:MM") xlApp.StatusBar = "Création des entêtes de colonnes. Veuillez patienter..." rows=2 ' On commence à la deuxième ligne '**********************On affiche le titre des colonnes choisies For IndiceTab = 0 To Ubound(TabCol) Set c=dataview.Columns(Val(TabCol(IndiceTab))) xlsheet.Cells(rows,cols).Value = c.title cols = cols + 1 Next '************************On affiches les valeurs des colonnes Set entry=vwnav.GetFirstDocument rows=3 ' On se place sur la troisième ligne Do While Not (entry Is Nothing) cols=1 For IndiceTab = 0 To Ubound(TabCol) colvals=entry.ColumnValues(Val(TabCol(IndiceTab))) 'Select Case scope 'Case "STRING" 'xlsheet.Cells(rows,cols).Value ="'" + colvals 'Case Else xlsheet.Cells(rows,cols).Value = colvals 'End Select cols=cols+1 Next xlApp.StatusBar = "Importation des données - Document " & rows-1 '& " sur " & dc.count & "." rows=rows+1 Set entry = vwnav.getnextdocument(entry) Loop '**************************Mise en page des données excel xlApp.Rows("1:1").Select xlApp.Selection.Font.Bold = True xlApp.Selection.Font.Underline = True xlApp.Range(xlsheet.Cells(2,1), xlsheet.Cells(rows,maxcols)).Select xlApp.Selection.Font.Name = "Arial" xlApp.Selection.Font.Size = 9 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.Range("A1").Select xlApp.StatusBar = "L'importation des données de Lotus Notes est terminé." '******************* Vous pouvez activer la ligne ci-dessous si vous voulez enregistrer le document en automatique'xlapp.ActiveWorkbook.saveas "C:\Vue" + Trim(Format(Now,"yyy")) ' Sauve le document dataview.clear Set xlapp=Nothing ' Stop l'automation excel Set db=NothingEnd Sub