DominoArea.org [Archive]

Bonjour à tous.

Je voudrais depuis une vue, selectionner les documents et récupérer les valeurs de chaque colonne de ma vue dans un fichier excel.

Le problème est que j'arrive à extraire la vue complete mais je ne parviens pas à faire la même chose mais uniquement pour les documents que je selectionne.

Cela fait un moment que je regarde et j'ai trouver quelques pistes mais j'aurais besoin d'aide.

D'après mes recherches, la class NotesViewEntryCollection semblerait faire ce que je souhaite mais est ce que quelqu'un pourrait me donner un exemple.

Merci de votre aide

Regarde du côté de la propriété ColumnValues de la classe NotesVIewEntry

je fait un petit tour dans ma toolskit et hop :


tu passe le nom de la vue et la collection de document selectionné dans la vue ça s'occupe du reste

Code : Tout sélectionner

Public Sub ExportViewToExcel(wNameView As String,wCollection As NotesDocumentCollection)
   
   rem wNameView contien le nom de la vue à traiter.

   Dim Doc As NotesDocument
   Dim vwView As NotesView
   Dim NameView As String
   Dim Selection As String
   Dim vwEntry As NotesViewEntry
   Dim vwViewColonne  As NotesViewColumn
   Dim vwNav As NotesViewNavigator
   Dim nbLigneTotal As Integer
   Dim nbColonneTotal As Integer
   Dim nbColonne As Integer
   Dim objXLSApp As Variant
   Dim objXLSWorkbooK As Variant
   Dim objXLSWorkSheet As Variant
   Dim nbLigneXLS As Long
   Dim nbColonneXLS As Long
   Dim OngletXLS As String
   Dim lstDoc List As String
   Dim nbCollection As Integer
   Dim UIWork As NotesUIWorkspace
   Dim tbReplaceOnglet (0 To 8) As String
   Dim tbReplace (0 To 1) As String
   Dim Valeur As String
   Const SeparatorValeur = ","
   
   On Error Goto CatchError
   
   Set UIWork = New NotesUIWorkSpace
   
   If DB Is Nothing Or Session Is Nothing Then
      Set Session = New NotesSession
      Set DB = Session.CUrrentdatabase
   End If
   
   rem connexion à la vue a exporter
   If Trim(wNameView) = "" Then
      Set vwView = UIWork.CurrentView.View
   Else
      Set vwView = DB.getView(wNameView)
   End If
   
   If vwView Is Nothing Then
      Error 9999,"vwView is Nothing"
      Exit Sub
   End If
   
   nbCollection = False
   If Not wCollection Is Nothing Then
      If wCollection.Count > 0 Then
         Set Doc = wCollection.GetFirstDocument
         While Not Doc Is Nothing
            lstDoc(Ucase(Trim(Doc.UniversalID))) = Ucase(Trim(Doc.UniversalID))
            Set Doc = wCollection.GetNextDocument(Doc)
         Wend
         nbCollection = True
      End If
   End If
   
   NameView = vwView.Name
   
   rem récupération du navigateur de vue
   Set vwNav = Nothing
   Set vwNav = vwView.createViewnav()
   
   If vwNav Is Nothing Then
      Msgbox "Le navigateur vue ''"+Trim(NameView)+"'' est introuvable.",16,"ERREUR !"
      Exit Sub
   End If
   
   nbLigneTotal = vwView.AllEntries.count
   nbColonneTotal = (vwview.ColumnCount-1)
   
   rem On récupère une instance Excel ouverte.
   Set objXLSApp = Nothing
   Set objXLSApp=createobject("Excel.Application")
   objXLSApp.DisplayAlerts=False
   objXLSApp.Visible=True
   objXLSApp.StatusBar = "Creating WorkSheet. Please be patient..."
   rem On instancit un objet WorkBook Excel et on ouvre le fichier de mise a jour.
   Set objXLSWorkbooK=objXLSApp.Workbooks.add
   
   rem On supprime les éventuelles feuilles en trop !
   While objXLSWorkbooK.sheets.count>1
      objXLSWorkbooK.sheets(2).select
      objXLSWorkbooK.sheets(2).Delete
   Wend
   
   rem elimination des caratères interdit dans l'onglet de la feuille excel
   OngletXLS = NameView+", "+Format(Now,"DD-MM-YYYY HH-NN-SS")
   If Len(OngletXLS) > 31 Then
      OngletXLS = NameView
   End If
   
   tbReplaceOnglet (0) = "/"
   tbReplaceOnglet (1) = "\"
   tbReplaceOnglet (2) = "?"
   tbReplaceOnglet (3) = "*"
   tbReplaceOnglet (4) = "["
   tbReplaceOnglet (5) = "]"
   tbReplaceOnglet (6) = "{"
   tbReplaceOnglet (7) = "}"
   tbReplaceOnglet (8) = ":"
   
   OngletXLS = Replace(OngletXLS,tbReplaceOnglet,"")
   
   Erase tbReplaceOnglet
   
   rem On renomme la première.
   objXLSWorkbooK.sheets(1).select
   objXLSWorkbooK.sheets(1).Name=Left(OngletXLS,31)
   
   rem On sélectionne la feuille de calcul qui nous intéresse.
   objXLSWorkbooK.Sheets(1).Select
   Set objXLSWorkSheet = objXLSApp.selection
   objXLSApp.Cells.Select
   objXLSApp.Selection.NumberFormat = "@"
   objXLSApp.Selection.HorizontalAlignment = -4131   
   
   nbColonneXLS = 1
   nbLigneXLS = 1
   
   rem on renseigne la premiere ligne avec le titre des colonnes
   rem  Print  "Insert Colonne"
   objXLSApp.StatusBar = "Importing view titles from Lotus Notes Application. Please be patient..."
   For nbColonne =0 To  nbColonneTotal
      Set vwViewColonne=vwView.Columns(nbColonne)
      rem 'n'export que les colonnes visibles
      If vwViewColonne.IsHidden = False Then
         Selection = vwViewColonne.title
         If Trim(Selection) = "" Then
            Selection = "          "  '"Sans Titre"
         End If
         objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value = Selection
         nbColonneXLS = nbColonneXLS + 1
      End If
      Set vwViewColonne = Nothing
      Selection = ""
   Next
   
   nbColonneXLS = 1
   nbColonne =0
   nbLigneXLS = 2
   
   tbReplace(0) = Chr(10)
   tbReplace(1) = Chr(13)
   
   rem remplissage de la feuille xls avec les données de la vue
   
   objXLSApp.StatusBar = "Importing Data from Lotus Notes Application. Please be patient..."
   If nbCollection = False Then
      Set vwEntry=vwNav.GetFirstDocument
      Do While Not (vwEntry Is Nothing)
         nbLigneXLS = nbLigneXLS + 1
         For nbColonne =0 To  nbColonneTotal
            Set vwViewColonne=vwView.Columns(nbColonne)
            rem n'export que les colonnes visibles
            If vwViewColonne.IsHidden = False Then
               If nbColonne <= Ubound(vwEntry.ColumnValues) Then
                  If IsArray(vwEntry.ColumnValues(nbColonne)) = True Then
                     Valeur = Replace(Trim(CStr(Join(vwEntry.ColumnValues(nbColonne),SeparatorValeur))),tbReplace,"")   
                  Else
                     Valeur = Replace(Trim(CStr(vwEntry.ColumnValues(nbColonne))),tbReplace,"")
                  End If
                  objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value=Valeur
                  Valeur = ""
               End If
               nbColonneXLS = nbColonneXLS+1
            End If
            Set vwViewColonne = Nothing
         Next
         nbColonneXLS = 1
         Set vwEntry = vwNav.getnextdocument(vwEntry)
      Loop
   Else
      Set vwEntry=vwNav.GetFirstDocument
      Do While Not (vwEntry Is Nothing)
         If Iselement ( lstDoc(Ucase(Trim(vwEntry.Document.UniversalID)))) = True Then
            nbLigneXLS = nbLigneXLS + 1
            For nbColonne =0 To nbColonneTotal
               Set vwViewColonne=vwView.Columns(nbColonne)
               rem n'export que les colonnes visibles
               If vwViewColonne.IsHidden = False Then
                  If nbColonne <= Ubound(vwEntry.ColumnValues) Then
                     If IsArray(vwEntry.ColumnValues(nbColonne)) = True Then
                        Valeur = Replace(Trim(CStr(Join(vwEntry.ColumnValues(nbColonne),SeparatorValeur))),tbReplace,"")   
                     Else
                        Valeur = Replace(Trim(CStr(vwEntry.ColumnValues(nbColonne))),tbReplace,"")
                     End If
                     objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS).Value=Valeur
                     Valeur = ""
                  End If
                  nbColonneXLS = nbColonneXLS+1
               End If
               Set vwViewColonne = Nothing
            Next
         End If
         nbColonneXLS = 1
         Set vwEntry = vwNav.getnextdocument(vwEntry)
      Loop
   End If
   
   Erase lstDoc
   nbColonneXLS = 0
   nbColonne =0
   nbLigneXLS = 0
   
   Erase tbReplace
   
   Set vwView = Nothing
   Set vwNav = Nothing
   Set vwViewColonne = Nothing
   Set vwEntry= Nothing
   
   rem Mise en page des données excel
   rem mise en page des titres des colonnes
   objXLSApp.Rows("1:1").Select
   objXLSApp.Selection.Font.Bold = True
   objXLSApp.Selection.Font.Underline = True
   
   rem mise en page de la feuille
   objXLSApp.Cells.Select
   rem objXLSApp.Range(objXLSWorkSheet.Cells(1,1), objXLSWorkSheet.Cells(nbLigneXLS,nbColonneXLS)).Select
   objXLSApp.Selection.NumberFormat = "@"
   objXLSApp.Selection.HorizontalAlignment = -4131   
   objXLSApp.Selection.Font.Name = "Arial"
   objXLSApp.Selection.Font.Size = 9
   objXLSApp.Selection.Columns.AutoFit
   objXLSApp.Selection.EntireRow.AutoFit   
   REM Portrait Orientation = 1, paysage Orientation = 2
   objXLSApp.Worksheets(1).Pagesetup.Orientation = 2
   objXLSApp.Worksheets(1).PageSetup.centerheader = "&8"+UCase(Trim(DB.title))+" - Export de la vue "+NameView+", Le "+Format(Now,"DD-MM-YYYY à HH:NN:SS")
   objXLSApp.Worksheets(1).Pagesetup.Rightheader = "&8Page &P / &T"
   objXLSApp.Worksheets(1).Pagesetup.CenterFooter = ""
   objXLSApp.Worksheets(1).Pagesetup.TopMargin = 30
   objXLSApp.Worksheets(1).Pagesetup.LeftMargin = 10
   objXLSApp.Worksheets(1).Pagesetup.RightMargin = 10
   objXLSApp.Worksheets(1).Pagesetup.BottomMargin = 10
   objXLSApp.Worksheets(1).Pagesetup.FooterMargin = 0
   objXLSApp.Worksheets(1).Pagesetup.HeaderMargin = 0
   objXLSApp.Worksheets(1).Pagesetup.CenterFooter = ""   
   objXLSApp.Worksheets(1).Pagesetup.CenterHorizontally = True
   objXLSApp.ReferenceStyle = 1
   objXLSApp.Range("A1").Select
   objXLSApp.Visible=True
   objXLSApp.StatusBar = "Importing Data from Lotus Notes Application was Completed."
   Set objXLSApp=Nothing
   rem   l'automation excel
   Set objXLSWorkbooK= Nothing
   
   Exit Sub
CatchError:
   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

clic droit, copier dans un tableau, puis coller dans Excel