par abcc » 14 Juin 2003 à 21:19
Je ne parviens toujours pas à recuperer le contenu du dc As NotesDocumentCollectionPB sur les lignesSet doc=dc.GetFirstDocumentetDo While Not (doc Is Nothing) cols=1 For IndiceTab = 0 To Ubound(TabCol) colvals=doc.ColumnValues(Val(TabCol(IndiceTab))) xlsheet.Cells(rows,cols).Value = colvals cols=cols+1 Next xlApp.StatusBar = "Importation des données - Document " & rows-1 '& " sur " & dc.count & "." rows=rows+1 Set doc = dc.GetNextDocument ( doc ) Loopla ligne colvals=doc....planteSub 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 doc As notesdocument 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 '************variables pour gérer la sélection de la vue courante Dim workspace As New NotesUIWorkspace Dim UIview As NotesUIView Dim countall As Long, countthis As Long, countallsel As Long, countthissel As Long Set db = session.CurrentDatabase Set dc=db.UnProcessedDocuments Set doc=dc.GetFirstDocument Msgbox("Pass 1") Set UIView = workspace.CurrentView UIViewname = UIView.ViewName UIViewAlias = UIView.Viewalias Set dataview = db.GetView( UIViewName ) gowithselection = False goonall = True '***********Determine si on a une collection (selection) countallsel = dc.count If countallsel >=1 Then gowithselection = workspace.Prompt(PROMPT_YESNO, "Selection trouvée", "Exporter uniquement les documents choisis?") Set doc=dc.getfirstdocument Msgbox " Selection valide" '***********Controler s'il y a reellement un document selectionne If (doc Is Nothing) And (goonwithselection) Then Msgbox " Selection invalide" Exit Sub End If Set doc = Nothing BarMsg = "Export des documents selectionnés..." Else goonall = workspace.Prompt(PROMPT_YESNO, "Pas Selection active", "Export tous les documents?" + Chr$(13) + "Info: Si vous souhaitez exporteruniquement les documents sélectionnés," + Chr$(13) + "Sselectionnez ces documents avant de lancer cette action.") If goonall=False Then Print "Sortie..." Exit Sub End If Set dc = Nothing BarMsg = "Export des documents ..." End If Set dataview = db.getview(UIViewname) ' 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 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 : " + UIViewname+ ", 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 rows=3 ' On se place sur la troisième ligne Do While Not (doc Is Nothing) cols=1 For IndiceTab = 0 To Ubound(TabCol) colvals=doc.ColumnValues(Val(TabCol(IndiceTab))) xlsheet.Cells(rows,cols).Value = colvals cols=cols+1 Next xlApp.StatusBar = "Importation des données - Document " & rows-1 '& " sur " & dc.count & "." rows=rows+1 Set doc = dc.GetNextDocument ( doc ) 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