Librairie Import/Export EXCEL - Gratos

[AdminExpert]

Voici un post à propos d'un export Excel.Il contient deux lib 1/ Common2/ CommonExcelet un exemple d'utilisation (fin de la page)ces lib sont améliorables bien entendu, elles ont été développées à l'époque brute de fonderie, vite fait.On y peut y ajouter toutes sortes de fonctions...je suis en train d'en faire une classe LS, je ferai un post dès qu'elle sera dispo.... j'y mettrai d'autres méthodes et propriétés...Attention : à tester en Web.... je n'ai pas fait les tests... j'attends vos retoursbonne utilisationSynopsis de base de documents Lotus Notes - créé à 16:09:24 le 16/12/2003Informations de bibliothèque de codesNom : CommonDernière modification : 16/12/2003 13:16:51Code LotusScript :Option PublicPublic Const IDOK = 1 Public Const IDCANCEL = 2 Public Const IDABORT = 3 Public Const IDRETRY = 4 Public Const IDIGNORE = 5 Public Const IDYES = 6 Public Const IDNO = 7 Dim Ws As NotesUIWorkSpaceDim UIDoc As NotesUIDocumentDim Session As NotesSessionDim Db As NotesDataBaseDim View As NotesViewDim Doc As NotesDocumentDim Collection As NotesDocumentCollectionDim CurrentDoc As NotesDocumentDim DlgBox As NotesDocumentDim RichStyle As NotesRichTextStyleDim RichItem As NotesRichTextItemDim Item As NotesItemDim ItemNames As NotesItemDim ItemReaders As NotesItemDim ItemAuthors As NotesItemSub InitializeEnd SubSub LoadSession Set Session=New NotesSession Set Db=Session.CurrentDataBaseEnd SubSub LoadDlgBox If DlgBox Is Nothing Then If Session Is Nothing Then LoadSession Set DlgBox=Db.CreateDocument End If End SubSub LoadStyle If Session Is Nothing Then Call LoadSession End If Set RichStyle = Session.CreateRichTextStyleEnd SubSub LoadRichText (NDoc As NotesDocument, RTName As String) Set RichItem = NDoc.CreateRichTextItem( RTName ) End SubSub LoadDocument (UI As Integer) If Session Is Nothing Then Call LoadSession End If If Not UI Then Set Doc=Db.CreateDocument Else Call LoadUI Set Doc=UIDoc.Document End IfEnd SubSub LoadUI If (UIDoc Is Nothing) Then Set Ws = New NotesUIWorkspace Set UIDoc = Ws.CurrentDocument End IfEnd SubSub LoadWs Set Ws = New NotesUIWorkspaceEnd SubSub CreateItem (NDoc As NotesDocument, FieldName As String, ValueV As Variant)' NAMES, READERS, or AUTHORS Set Item = New NotesItem( NDoc, FieldName, ValueV )End SubSub CreateItemNames (NDoc As NotesDocument,FieldName As String, ValueV As Variant)' NAMES, READERS, or AUTHORS Set ItemNames = New NotesItem( NDoc, FieldName, ValueV,NAMES )End SubSub CreateItemReaders (NDoc As NotesDocument,FieldName As String, ValueV As Variant)' NAMES, READERS, or AUTHORS Set ItemReaders = New NotesItem( NDoc, FieldName, ValueV,READERS )End SubSub CreateItemAuthors (NDoc As NotesDocument,FieldName As String, ValueV As Variant)' NAMES, READERS, or AUTHORS Set ItemAuthors = New NotesItem( NDoc, FieldName, ValueV,AUTHORS )End Sub----------------------------------------------------------------------------------------------- Nom : CommonExcelDernière modification : 16/12/2003 13:41:45Code LotusScript :Option PublicUse "XL97CONST"Dim Xl As VariantDim xlWkb As VariantDim ActiveWk As VariantDim Feuille As Variant Dim Ligne As LongDim Col As IntegerDim Cellule As Variant Dim Eos As IntegerConst APPS="Excel.Application"Sub InitializeEnd SubFunction LoadExcel() Dim Ret As Integer On Error Goto ErrorExcel Ret=False Set XL=CreateObject(APPS) Ret=True Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"LoadExcel" Ret=False Resume FinFin: LoadExcel=RetEnd FunctionFunction LoadAddWorkBooks() Dim Ret As Integer On Error Goto ErrorExcel Ret=False Set xlWkb=xl.Workbooks.Add Ret=True Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"LoadAddWorkBooks" Ret=False Call LoadExcelQuit() Resume FinFin: LoadAddWorkBooks=RetEnd FunctionFunction LoadActiveSheet () Dim Ret As Integer On Error Goto ErrorExcel Ret=False Set Feuille=ActiveWk.activesheet Set Cellule=Feuille.Cells Ret=True Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"LoadActiveSheet" Call LoadExcelQuit() Ret=False Resume FinFin: LoadActiveSheet=RetEnd FunctionFunction LoadWorkBooks() Dim Ret As Integer On Error Goto ErrorExcel Ret=False Set xlWkb=XL.workbooks Ret=True Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"LoadWorkBooks" Call LoadExcelQuit() Ret=False Resume FinFin: LoadWorkBooks=RetEnd FunctionFunction LoadOpenWorkBooks (XlsName As String) As Integer Dim Ret As Integer On Error Goto ErrorExcel xlWkb.Open XlsName Ret=True Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"LoadOpenWorkBooks : " & XlsName Ret=False Call LoadExcelQuit() Resume FinFin: LoadOpenWorkBooks=RetEnd FunctionFunction LoadSaveWorkBooks (XlsName As String) As Integer Dim Ret As Integer On Error Goto ErrorExcel If Dir$(XlsName)<>"" Then Kill XlsName Xl.ActiveWorkbook.SaveAs XlsName Ret=True Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"LoadSaveWorkBooks : " & XlsName Ret=False Call LoadExcelQuit() Resume FinFin: LoadSaveWorkBooks=RetEnd FunctionFunction LoadActiveWorkBooks() Dim Ret As Integer On Error Goto ErrorExcel Ret=False Set ActiveWk=xl.ActiveWorkBook Ret=True Goto finErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"LoadActiveWorkBooks" Call LoadExcelQuit() Ret=False Resume FinFin: LoadActiveWorkBooks=RetEnd FunctionFunction LoadCreateXLS (XlsName As String) As Integer Dim Ret As Integer Ret=False If Dir$(XLSName)<>"" Then Kill XLSName If Not LoadExcel() Then Goto Fin If Not LoadAddWorkBooks() Then Goto Fin If Not LoadActiveWorkBooks() Then Goto Fin If Not LoadActiveSheet() Then Goto Fin Ret=True Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"LoadCreateXLS : " & XlsName Ret=False Call LoadExcelQuit() Resume FinFin: LoadCreateXLS=RetEnd FunctionFunction LoadReadXLS (XLSName As String) Dim Ret As Integer Ret=False If Not LoadExcel() Goto fin If Not LoadWorkBooks() Then Goto fin If Not LoadOpenWorkBooks(XLSName) Goto fin If Not LoadActiveWorkBooks() Then Goto fin If Not LoadActiveSheet() Then Goto fin Ret=True Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"LoadCreateXLS : " & XlsName Ret=False Call LoadExcelQuit () Resume FinFin: LoadReadXLS=RetEnd FunctionFunction LoadExcelQuit() Dim Ret As Integer On Error Goto ErrorExcel Ret=False If Not XL Is Nothing Then If Not ActiveWk Is Nothing Then ActiveWk.Close Call XL.Quit End If Ret=True Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"LoadExcelQuit : " Ret=False Resume FinFin: LoadExcelQuit=RetEnd FunctionFunction RCellule (L As Long, C As Integer) As Variant Dim V As Variant On Error Goto ErrorExcel V=Cellule(L,C).Value Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"VCellule(" & L & "," & C & ")" Call LoadExcelQuit() V=Null Resume FinFin: RCellule=VEnd FunctionSub PCellule(L As Long, C As Integer, V As Variant) On Error Goto ErrorExcel xlWkb.ActiveSheet.Cells(L,C)=V Goto FinErrorExcel: Messagebox "Erreur " & Err & " : " & Error$,16,"PCellule(" & L & "," & C & ")" Call LoadExcelQuit() V=Null Resume FinFin: End SubSub BoldRows(L As Long, Trigger As Integer) xlWkb.ActiveSheet.Rows(L).Font.Bold=TriggerEnd SubSub ItalicRows(L As Long, Trigger As Integer) xlWkb.ActiveSheet.Rows(L).Font.Italic=Trigger End SubSub UnderLineRows(L As Long, Trigger As Integer) xlWkb.ActiveSheet.Rows(1).Font.Underline=TriggerEnd SubSub FontSizeRows(L As Long, Trigger As Integer) xlWkb.ActiveSheet.Rows(L).Font.Size=TriggerEnd SubSub AutoFit xlWkb.ActiveSheet.Columns.AutoFitEnd SubSub AutoFilter (RangeArea As String) xlWkb.ActiveSheet.Range(RangeArea).AutoFilter End SubSub WidthRows( RangeArea As String, Trigger As Integer) xlWkb.ActiveSheet.Columns(RangeArea).ColumnWidth=TriggerEnd SubSub WrapRrows( RangeArea As String, Trigger As Integer) XLWKb.ActiveSheet.Columns(RangeArea).WrapText=TriggerEnd SubSub StyleBorderContinue (Areas As String) With XLWKB.ActiveSheet.Range(Areas).Borders .LineStyle=xlContinuous End WithEnd SubSub SetXLAlert(Trigger As Integer) XL.DisplayAlerts = TriggerEnd Sub ----------------------------------------------------------------------------------------------- Informations d'agentNom : Export vers ExcelDernière modification : 16/12/2003 14:11:21Commentaire : [Sans]Agent partagé : OuiType : LotusScriptEtat : Activé(e)Déclencher : Lorsque vous le sélectionnez dans le menu Actions.S'applique à : Exécuter une fois (commandes @ autorisées)Code LotusScript :Option PublicUse "Common"Use "CommonExcel"Sub Initialize Const FICHIER="c:\mes documents\fichiers.xls" Dim C As Long Dim L As Long On Error Goto HandleError L=1 '--- Session Lotus Notes --- Print "Initialisation" Call LoadSession Set View=Db.GetView("VPLAYERS") Print "Création du fichier Excel en cours..." '--- Init objet Excel --- Call LoadCreateXLS(FICHIER) Call SetXLAlert(False) Print "APP Excel : OK" '--- Titre des colonnes --- Call PCellule(L,1,"Num") Call PCellule(L,2,"Name") Call PCellule(L,3,"Position") Call PCellule(L,4,"Bats") '--- Explore la vue & ecrit dans les cellules --- Set Doc=View.GetFirstDocument While Not (Doc Is Nothing) L=L+1 Print "Lecture du document ";L Call PCellule(L,1,Doc.Number(0)) Call PCellule(L,2,Doc.Name(0)) Call PCellule(L,3,Doc.Position(0)) Call PCellule(L,4,Doc.Bats(0)) Set Doc=View.GetNextDocument(Doc) Wend '--- Largeur automatique des colonnes --- Call AutoFit '--- On sauvegarde le fichier --- Call LoadSaveWorkBooks (FICHIER) Msgbox "Export terminé",64,"Export" Goto Fin '--- Que faire en cas d'erreur ? ---HandleError: Msgbox "Erreur " & Error & " : " & Error$ Resume Fin '--- On sort proprement ! ---Fin: Call LoadExcelQuitEnd Sub

[yop]

t'es obligé de préciser 'gratos' à chaque fois ?oui, c'est un forum libre donc tout ce que les gens postent est réutilisable.

[AdminExpert]

comme dit l'autre c'est pour rireet je ne cherche pas à gagner ma vie dans ce forumalors si monsieur n'aime pas la plaisanterie...excuses moi si je te fais trop rire !je ne pensais pas atteindre une telle susceptibilité !carpe diem...

[Cedric]

bon, ça a au moins le mérite d'exister. )quelques remarques:- où trouver le fichier XL97CONST ? Tel quel à l'enregistrement il ne me trouve pas le fichier J'utilise office 2000, j'ai cherché un fichier du type *xl*const*.* mais sans succès.- J'aime bien les "option declare" dans le code. Ici il n'y en a pas mais au moins la librairie Common s'enregistre sans problème quand on le rajoute, donc toutes les variables sont déclarées et justes (ca c bien).- J'aime pas les goto , dans ta version objet que tu écris, ce qui serait bien serait de rediriger en cas d'erreur sur une méthode de gestion dédiée que l'on pourrait dériver et donc implémenter comme on a envie, des fois la messagebox (bloquante) n'est pas le meilleur choix.- J'avais fait un truc similaire fut une époque et je crois me souvenir qu'il y avait des petites différences entre les versions d'excel. A part excel 97, quelle version as tu testé ton code ?Voila, fin de mes remarques simplement (constructives je l'espère), aucune critique ni attaque, je préfère préciser...Cela a le mérite d'exister et c'est toujours bien de voir qu'il y en a qui DONNENT leur code, après "gratos" ou "libre", ce ne sont que des mots C'est le principe qu'il faut respecter.Donc merci.

[AdminExpert]

ok, je sais pour les goto, mais parfois au risque d'être "verbieu" dans le code, un goto simplement pour sortir sans de la prog boule de laine est préférable, je suis avec toi sur le principesi tu as mail je peux te le faire parvenir le fichier x97, je l'ai trouvé sur le net et j'ai mis du temps ou au mieux je te file la base notes que j'ai développé c'est plus simple.... email ?le but de ce code était de faire vite...pour les attaks pas de pb... mais bon comme tu dis, je donne mon code et j'envoie même mes base y a en qquns de ce forum à qui j'ai déjà envoyé ss pb...a+

[AdminExpert]

tiens j'ai retrouvé url où j'avais trouvé ce fichierhttp://www-10.lotus.com/ldd/sand ... Documentsi tu as des pb pour l'avoir je peux te faire le mail