DominoArea.org [Archive]

J'ai revu ma classe de base pour les imports/exports excel
voici la première version 1.1
celle-ci devrait évoluer.
En effet, après de nombreux usages, je n'étais pas entièrement satisfait de la 1.0 qui date de 2002 déjà.

J'ai aussi ajouté d'autres propriétés et méthodes.

Lib = ClassExcel

[syntax="ls"]
'//====================================================================
'// Ensemble de classes pour la gestion des fichiers sous Excel
'// - Exportation
'// - Importation
'//====================================================================


Public Class ExcelSession
Private XLApp As Variant
Private XLWorkBook As Variant
Private ActiveWorkBook As Variant
Private Sheet As Variant
Private Cells As Variant
Private Sheets As Variant
Private Columns As Variant
Private Rows As Variant
Private Workbooks As Variant
Private Application As Variant
Private Worksheets As Variant

Property Get GetXLApp As Variant
Set GetXLApp=XLApp
End Property

Property Get GetXLWorkBook As Variant
Set GetXLWorkBook=XLWorkBook
End Property

Property Get GetActiveWorkBook As Variant
Set GetActiveWorkBook=ActiveWorkBook
End Property

Property Get GetSheet As Variant
Set GetSheet=Sheet
End Property

Property Get GetCells As Variant
Set GetCells=Cellule
End Property

Property Set visible As Integer
XLApp.Visible = visible
End Property

Property Set DisplayAlerts As Integer
XLApp.DisplayAlerts = DisplayAlerts
End Property

Property Set StatusBar As String
XLApp.StatusBar = StatusBar
End Property

'//--- Constructeur
Sub new
Set XLApp = CreateObject("Excel.Application")
If XLApp Is Nothing Then
Error 9999, "Impossible d'initier la session Excel"
End If
End Sub

'//--- Initialisation des objets
Private Sub Init
Set ActiveWorkBook=XLApp.ActiveWorkBook
If ActiveWorkBook Is Nothing Then
Error 9999, "Impossible d'initier le classeur actif"
End If
Set Sheet=ActiveWorkBook.ActiveSheet
If Sheet Is Nothing Then
Error 9999, "Impossible d'initier la feuille active"
End If
Call OtherInit
End Sub

Private Sub OtherInit
Set Sheets=XLApp.Sheets
Set Columns = Sheet.Columns
Set Rows = Sheet.Rows
Set Workbooks=XLApp.Workbooks
Set Application=XLApp
Set Worksheets=ActiveWorkbook.Worksheets
End Sub

'// ---------------------------------------------------------------------------
'// Ouverture, Sauvegarde, Fermeture
'// ---------------------------------------------------------------------------

'//--- Ouverture
Sub OpenWorkBook(filename As String, active As Integer)
On Error Resume Next
XLWorkBook.Open filename
If Err Then
Error 9999, "Impossible d'ouvrir le fichier " & filename
End If
If active Then
Call init
Set Cells=Sheet.Cells
End If
End Sub

'//--- Sauvegarde de la feuille ---
Sub SaveAs(FileName As String)
XlApp.ActiveWorkbook.SaveAs FileName
If Err Then
Error 9999, "Impossible de sauvegarder le classeur " & filename
End If
End Sub

'//--- sauvegarde
Sub Save
On Error Resume Next
If isEcho Then Print "Sauvegarde du fichier"
XlApp.ActiveWorkbook.Save
If Err Then
Error 9999, "Impossible de sauvegarder le classeur"
End If
End Sub

'//--- Fermeture
Sub CloseActiveWorkBook
On Error Resume Next
ActiveWorkBook.Close
If Err Then
Error 9999, "Impossible de fermer le classeur en cours"
End If
End Sub

'//--- Quitte
Sub CloseSession
On Error Resume Next
XLApp.Quit
If Err Then
Error 9999, "Impossible de fermer la session Excel"
End If
End Sub

End Class

'// ------------------------------------------------------------------------------------------
'// Liste des méthodes disponibles la gestion des feuilles
'// -------------------------------------------------------------------------------------------
Public Class ExcelMethods As ExcelSession

'// ---------------------------------------------------------------------------
'// Ecriture dans une cellule
'// ---------------------------------------------------------------------------
Sub SetCellule(Ligne As Long, colonne As Long, v As Variant)
On Error Resume Next
Sheet.Cells(Ligne,Colonne)=v
If Err Then
Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End If
End Sub

'// ---------------------------------------------------------------------------
'// Lecture d'une cellule
'// ---------------------------------------------------------------------------
Function GetCellule(L As Long, C As Long) As Variant
On Error Resume Next
GetCellule=Cells(L,C).Value
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Function

'// ---------------------------------------------------------------------------
'// Nombre lignes et colonnes actives
'// ---------------------------------------------------------------------------

'/--- Colonnes
Function GetColumns() As Long
On Error Resume Next
Sheet.Cells.SpecialCells(11).Activate
GetColumns = XLApp.ActiveWindow.ActiveCell.Column
End Function

'/--- lignes
Function GetRows() As Long
On Error Resume Next
Sheet.Cells.SpecialCells(11).Activate
GetRows = XLApp.ActiveWindow.ActiveCell.Row
End Function

'// ---------------------------------------------------------------------------
'// Gestion des feuilles
'// ---------------------------------------------------------------------------

'//--- Nommer une feuille
Sub SetSheetName(n As String)
On Error Resume Next
sheet.name=n
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- Nombre de feuilles
Function GetSheets() As Integer
On Error Resume Next
GetSheets=Sheets.Count
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
'Application.Sheets.Add before:=Sheets.Item(Sheets.Count), Type:=xlWorksheet
End Function

'//--- Ajouter une feuille
Sub AddSheet()
On Error Resume Next
With Sheets.Add
.Before=(Sheets.Count)
.Type=xlWorksheet
End With
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- Rendre une feuille active
Sub SetSheet(f As Integer)
'--- Set Sheet=XLApp.Workbooks(1).Worksheets(n)
'--- La méthode ci-dessous est plus relative
On Error Resume Next
Set Sheet=ActiveWorkBook.Worksheets(n)
If Err Then
Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
Else
Set Cells=Sheet.Cells
End If
End Sub

'// ---------------------------------------------------------------------------
'// Filtres automatiques
'// ---------------------------------------------------------------------------
Sub AutoFilter (RangeArea As String)
On Error Resume Next
Sheet.Range(RangeArea).AutoFilter
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// ---------------------------------------------------------------------------
'// Filtres automatiques
'// ---------------------------------------------------------------------------
Sub AutoFormat(d As Variant, f As Variant, style As Integer)
XLApp.Range(d, f).Select
Call XLApp.Selection.AutoFormat(style,True,True,True,True,True,True)
End Sub

'// ---------------------------------------------------------------------------
'// Tri d'une feuille
'// ---------------------------------------------------------------------------
Sub sortCells1(d As Variant, f As Variant, k1 As Variant)
'Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3,
'Header, OrderCustom, MatchCase, Orientation, SortMethod,
'DataOption1, DataOption2, DataOption3)
Dim selection As Variant
XLApp.Range(d,f).Select
Set selection=XLApp.Selection
Call Selection.Sort(k1,xlAscending)
End Sub

Sub sortRangeArea1(Area As String, k1 As Variant)
Dim selection As Variant
XLApp.Range(Area).Select
Set selection=XLApp.Selection
Call Selection.Sort(k1,xlAscending)
End Sub

Sub sortCells2(d As Variant, f As Variant, k1 As Variant, k2 As Variant)
Dim selection As Variant
XLApp.Range(d,f).Select
Set selection=XLApp.Selection
Call Selection.Sort(k1,xlAscending,k2,,xlAscending)
End Sub

Sub sortRangeArea2(Area As String, k1 As Variant, k2 As Variant)
Dim selection As Variant
XLApp.Range(Area).Select
Set selection=XLApp.Selection
Call Selection.Sort(k1,xlAscending,k2,,xlAscending)
End Sub

Sub sortCells3(d As Variant, f As Variant, k1 As Variant, k2 As Variant, k3 As Variant)
Dim selection As Variant
XLApp.Range(d,f).Select
Set selection=XLApp.Selection
Call Selection.Sort(k1,xlAscending, k2, ,xlAscending ,k3,xlAscending)
End Sub

Sub sortRangeArea3(Area As String, k1 As Variant, k2 As Variant, k3 As Variant)
Dim selection As Variant
XLApp.Range(Area).Select
Set selection=XLApp.Selection
Call Selection.Sort(k1,xlAscending,k2, , xlAscending,k3,xlAscending)
End Sub

'// ---------------------------------------------------------------------------
'// Largeur colonne, hauteur ligne
'// ---------------------------------------------------------------------------

'// Largeur automatique des colonnes
Sub AutoFit
On Error Resume Next
Sheet.Columns.AutoFit
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- Largeur d'une colonne ---
Sub WidthColumns( C As String, Trigger As Integer)
On Error Resume Next
Sheet.Columns(C).ColumnWidth=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- Hauteur d'une ligne
Sub RowHeight( L As Variant, Trigger As Variant)
On Error Resume Next
Sheet.Rows(L).RowHeight=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// ---------------------------------------------------------------------------
'// Gestion des fontes
'// ---------------------------------------------------------------------------

'-- Gestion des fontes
Sub SetFontRows(L As Variant, Trigger As String)
On Error Resume Next
Sheet.Rows(L).Font.Name=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetFontColumns(C As String, Trigger As String)
On Error Resume Next
Sheet.Columns(C).Font.Name=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetFontRange(Area As String, Trigger As String)
On Error Resume Next
Sheet.Range(Area).Font.Name=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetFontCells(L As Long, C As Long, Trigger As String)
On Error Resume Next
Sheet.Cells(L,C).Font.Name=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// ---------------------------------------------------------------------------
'// Formatage des cellulles
'// ---------------------------------------------------------------------------

Sub SetNumberFormatRows(L As Variant, Trigger As String)
On Error Resume Next
Sheet.Rows(L).NumberFormat=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetNumberFormatColumns(C As String, Trigger As String)
On Error Resume Next
Sheet.Columns(C).NumberFormat=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetNumberFormatRange(Area As String, Trigger As String)
On Error Resume Next
Sheet.Range(Area).NumberFormat=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetNumberFormatCells(L As Long, C As Long, Trigger As String)
On Error Resume Next
Sheet.Cells(L,C).NumberFormat=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// ---------------------------------------------------------------------------
'// Alignement des cellules
'// ---------------------------------------------------------------------------

'--- Alignement vertical ---
' xlVAlignBottom, xlVAlignCenter, xlVAlignDistributed, xlVAlignJustify, xlVAlignTop
Sub VerticalAlignementRows(L As Variant, Trigger As Variant)
On Error Resume Next
Sheet.Rows(L).VerticalAlignment=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub VerticalAlignementColumns(C As String, Trigger As Variant)
On Error Resume Next
Sheet.Columns(C).VerticalAlignment=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub VerticalAlignementRange(Area As String, Trigger As Variant)
On Error Resume Next
Sheet.Range(Area).VerticalAlignment=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub VerticalAlignementCells(L As Long, C As Long, Trigger As Variant)
On Error Resume Next
Sheet.Cells(L,C).VerticalAlignment=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'--- Alignement horizontal --
' xlHAlignCenter, xlHAlignDistributed, xlHAlignJustify, xlHAlignLeft, or xlHAlignRight
Sub HorizontalAlignementRows(L As Variant, Trigger As Variant)
On Error Resume Next
Sheet.Rows(L).HorizontalAlignment=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub HorizontalAlignementColumns(C As String, Trigger As Variant)
On Error Resume Next
Sheet.Columns(C).HorizontalAlignment=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub HorizontalAlignementRange(Area As String, Trigger As Variant)
On Error Resume Next
Sheet.Range(Area).HorizontalAlignment=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub HorizontalAlignementCells(L As Long, C As Long, Trigger As Variant)
On Error Resume Next
Sheet.Cells(L,C).HorizontalAlignment=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// ---------------------------------------------------------------------------
'// Gestion des bordures
'// ---------------------------------------------------------------------------

'// --- type de trait (s) ---
' // xlContinuous, xlDash, xlDashDot,xlDashDotDot, xlDot, xlDouble, xlLineStyleNone ou xlSlantDashDot
'// --- Epaisseur (w) ---
' xlHairline, xlThin, xlMedium ou xlThick
Sub StyleBorderRange (Areas As String, s As Variant, w As Variant)
On Error Resume Next
With Sheet.Range(Areas).Borders
.LineStyle=s
.Weight = w
End With
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub StyleBorderColumns (C As String, s As Variant, w As Variant)
On Error Resume Next
With Sheet.Columns(C).Borders
.LineStyle=s
.Weight = w
End With
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub StyleBorderRows (L As Variant, s As Variant, w As Variant)
On Error Resume Next
With Sheet.Rows(L).Borders
.LineStyle=s
.Weight = w
End With
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub StyleBorderCells (L As Integer, C As Integer, s As Variant, w As Variant)
On Error Resume Next
With Sheet.Cells(L,C).Borders
.LineStyle=s
.Weight = w
End With
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// ---------------------------------------------------------------------------
'// Mise en forme des cellules (gras, souligné, italic)
'// ---------------------------------------------------------------------------

'--- Taille de la fonte ---
Sub FontSizeRows(L As Variant, Trigger As Integer)
On Error Resume Next
Sheet.Rows(L).Font.Size=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub FontSizeColumns(C As String, Trigger As Integer)
On Error Resume Next
Sheet.Columns(C).Font.Size=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub FontSizeRange(Area As String, Trigger As Integer)
On Error Resume Next
Sheet.Range(Area).Font.Size=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub FontSizeCells(L As Long, C As Long, Trigger As Integer)
On Error Resume Next
Sheet.Cells(L,C).Font.Size=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// --- Soulignement d'une ligne ---
'// xlUnderlineStyleNone, xlUnderlineStyleSingle, xlUnderlineStyleDouble, xlUnderlineStyleSingleAccounting
'// xlUnderlineStyleDoubleAccounting
Sub UnderLineRows(L As Variant, u As Long)
On Error Resume Next
Sheet.Rows(L).Font.Underline=u
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub UnderLineCells(L As Long, C As Long, u As Long)
On Error Resume Next
Sheet.Cells(L,C).Font.Underline=u
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub UnderLineColumns(C As String, u As Long)
On Error Resume Next
Sheet.Columns(C).Font.Underline=u
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub UnderLineRange(Area As String, u As Long)
On Error Resume Next
Sheet.Range(Area).Font.Underline=u
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- Italic d'une ligne ---
Sub ItalicRows(L As Variant, Trigger As Integer)
On Error Resume Next
Sheet.Rows(L).Font.Italic=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub ItalicColumns(C As String, Trigger As Integer)
On Error Resume Next
Sheet.Columns(C).Font.Italic=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub ItalicRange(Area As String, Trigger As Integer)
On Error Resume Next
Sheet.Range(Area).Font.Italic=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub ItalicCells(L As Long, C As Long, Trigger As Integer)
On Error Resume Next
Sheet.Cells(L,C).Font.Italic=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- Gras d'une ligne ---
Sub BoldRows(L As Variant, Trigger As Integer)
On Error Resume Next
Sheet.Rows(L).Font.Bold=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub BoldColumns(C As String, Trigger As Integer)
On Error Resume Next
Sheet.Columns(C).Font.Bold=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub BoldCells(L As Long, C As Long,Trigger As Integer)
On Error Resume Next
Sheet.Cells(L, C).Font.Bold=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub BoldRange(Area As String, Trigger As Integer)
On Error Resume Next
Sheet.Range(Area).Font.Bold=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'--- Retour à la ligne automatique ---
Sub WrapColumns( C As String, Trigger As Integer)
On Error Resume Next
Sheet.Columns(C).WrapText=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub WrapRows( L As Variant, Trigger As Integer)
On Error Resume Next
Sheet.Rows(L).WrapText=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub WrapRange( Area As String, Trigger As Integer)
On Error Resume Next
Sheet.Range(Area).WrapText=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub WrapCells( L As Long, C As Long, Trigger As Integer)
On Error Resume Next
Sheet.Cells(L,C).WrapText=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub


'// ---------------------------------------------------------------------------
'// Mise en page de la feuille Excel et impression
'// ---------------------------------------------------------------------------

'// Orientation de la feuille
Sub SetOrientation(o As Integer)
On Error Resume Next
Sheet.PageSetup.Orientation = o
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// Entête et bas de page
Sub PageSetup(header As String, footer As String)
On Error Resume Next
With sheet
.PageSetup.centerheader = header
.Pagesetup.RightFooter = "Page : &P"
.Pagesetup.CenterFooter = footer
End With
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// Mise en page détaillée
Sub SetLeftHeader (trigger As String)
On Error Resume Next
Sheet.PageSetup.LeftHeader = Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetCenterHeader (trigger As String)
On Error Resume Next
Sheet.PageSetup.CenterHeader = Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetRightHeader (trigger As String)
On Error Resume Next
Sheet.PageSetup.RightHeader = Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetLeftFooter (trigger As String)
On Error Resume Next
Sheet.PageSetup.LeftFooter = Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetCenterFooter (trigger As String)
On Error Resume Next
Sheet.PageSetup.CenterFooter = Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

Sub SetRightFooter (trigger As String)
On Error Resume Next
Sheet.PageSetup.RightFooter = Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- nb page en hauteur
Sub SetFitToPagesTall(trigger As Integer)
On Error Resume Next
sheet.PageSetup.Zoom = False
Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
Sheet.PageSetup.FitToPagesTall=Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- nb page en largeur
Sub SetFitToPagesWide(trigger As Integer)
On Error Resume Next
sheet.PageSetup.Zoom = False
Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
sheet.PageSetup.FitToPagesWide=trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//-- entête de colonne
Sub SetPrintTitleColumns(Area As String)
On Error Resume Next
sheet.PageSetup.PrintTitleColumns=Areas
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- entête de ligne
Sub SetPrintTitleRows(Areas As String)
On Error Resume Next
Sheet.PageSetup.PrintTitleRows=Areas
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- centrage horizontal
Sub SetCenterHorizontally(trigger As Integer)
On Error Resume Next
Sheet.PageSetup.CenterHorizontally=trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- centrage vertical
Sub SetCenterCenterVertically(trigger As Integer)
On Error Resume Next
Sheet.PageSetup.CenterVertically=trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// Définir le bloc d'impression
Sub SetPrintArea (Area As String)
On Error Resume Next
Sheet.PageSetup.PrintArea = Area
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'// Impression en mode brouillon
Sub SetPrintDraft (trigger As Integer)
On Error Resume Next
Sheet.PageSetup.Draft = Trigger
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

'//--- imprimer la feuille
Sub PrintSheet
On Error Resume Next
Sheet.PrintOut
If Err Then Error 9999,"Erreur excel (" & Lsi_info(2) & ")"
End Sub

End Class

'// ---------------------------------------------------------------------------
'// Importation d'une feuille Excel
'// ---------------------------------------------------------------------------
Public Class ExcelImport As ExcelMethods
Sub new
Set XLWorkBook=XLApp.workbooks
If XLWorkBook Is Nothing Then
Error 9999, "Impossible d'initier le classeur"
End If
End Sub
End Class

'// ---------------------------------------------------------------------------
'// Importation d'une feuille Excel
'// ---------------------------------------------------------------------------
Public Class ExcelExport As ExcelMethods
Sub new
Set XLWorkBook=XLApp.Workbooks.Add
If XLWorkBook Is Nothing Then
Error 9999, "Impossible d'initier le classeur"
End If
Call Init
End Sub
End Class


'// ---------------------------------------------------------------------------
'// Importation d'une feuille Excel
'// ---------------------------------------------------------------------------
Public Class ExcelImport As ExcelMethods
Sub new
Set XLWorkBook=XLApp.workbooks
If XLWorkBook Is Nothing Then
Error 9999, "Impossible d'initier le classeur"
End If
End Sub
End Class

'// ---------------------------------------------------------------------------
'// Importation d'une feuille Excel
'// ---------------------------------------------------------------------------
Public Class ExcelExport As ExcelMethods
Sub new
Set XLWorkBook=XLApp.Workbooks.Add
If XLWorkBook Is Nothing Then
Error 9999, "Impossible d'initier le classeur"
End If
Call Init
End Sub
End Class
[/syntax]

un petit exemple d'utilisation

Option Public
Use "ClassExcel"

[syntax="ls"]
Sub Initialize
Const xlUnderlineStyleSingle = 2
Dim session As NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim colonne As Long
Dim ligne As Long
Dim XLApp As Variant
Dim WorkBook As Variant
Dim ActiveWorkBook As Variant
Dim Sheet As Variant
Dim ee As ExcelExport
Dim s As Variant
On Error Goto Erreur
'//----------------------------------------------------------------------------------
'// Initialisation de la session, base actuelle et vue
'//----------------------------------------------------------------------------------
Set session=New NotesSession
Set db = session.CurrentDatabase
Set view = db.GetView("By number")
'//----------------------------------------------------------------------------------
'// Initialise l'objet
'//----------------------------------------------------------------------------------
Set ee = New ExcelExport()
ee.DisplayAlerts=False
'//----------------------------------------------------------------------------------
'// On récupère ses propriétés
'//----------------------------------------------------------------------------------
Set XLApp=ee.GetXLApp
Set Sheet=ee.GetSheet
Set WorkBook=ee.GetXLWorkBook
Set ActiveWorkBook=ee.GetActiveWorkBook
'//----------------------------------------------------------------------------------
'// On nomme la feuille
'//----------------------------------------------------------------------------------
Call ee.SetSheetName("Liste des joueurs")
Ligne=1
'//----------------------------------------------------------------------------------
'// Titre à la ligne 1
'//----------------------------------------------------------------------------------
Call ee.SetFontCells(ligne,2,"Comic Sans MS")
Call ee.SetFontCells(ligne,4,"Comic Sans MS")
'//----------------------------------------------------------------------------------
'// mise en forme
'//----------------------------------------------------------------------------------
Call ee.BoldCells(ligne,2,True)
Call ee.BoldCells(ligne,4,True)
Call ee.ItalicCells(ligne,2,True)
Call ee.ItalicCells(ligne,4,True)
Call ee.FontSizeCells(ligne,2,12)
Call ee.FontSizeCells(ligne,4,12)
Call ee.SetCellule(Ligne,2,"LISTE DES JOUEURS")
Call ee.SetCellule(Ligne,4,"SAISON 2005")
ligne=3
Call ee.SetCellule(Ligne,1,"N°")
Call ee.SetCellule(Ligne,2,"Nom")
Call ee.SetCellule(Ligne,3,"Age")
Call ee.SetCellule(Ligne,4,"Position")
Call ee.SetCellule(Ligne,5,"Lieu de naissance")
'//----------------------------------------------------------------------------------
'// Première méthode
'//----------------------------------------------------------------------------------
Call ee.BoldRows("3:3",True)
Call ee.ItalicRows("3:3",True)
Call ee.UnderLineRows("3:3",xlUnderlineStyleSingle)
'//----------------------------------------------------------------------------------
'// Seconde méthode
'//----------------------------------------------------------------------------------
XLApp.Rows("3:3").Select
XLApp.Selection.Font.Bold = True
XLApp.Selection.Font.Underline = True
'//----------------------------------------------------------------------------------
'// Balayage de la vue
'//----------------------------------------------------------------------------------
Set doc = view.GetFirstDocument
Do While Not (doc Is Nothing)
ligne = ligne +1
Call ee.SetCellule(Ligne,1,doc.Number(0))
Call ee.SetCellule(Ligne,2,doc.Name(0))
Call ee.SetCellule(Ligne,3,doc.Age(0))
Call ee.SetCellule(Ligne,4,doc.Position(0))
Call ee.SetCellule(Ligne,5,doc.Born(0))
Set doc = view.GetNextDocument(doc)
Loop
'//----------------------------------------------------------------------------------
'// Autofit première méthode
'//----------------------------------------------------------------------------------
Call ee.Autofit
'//----------------------------------------------------------------------------------
'// Différentes formes de tris
'//----------------------------------------------------------------------------------
'//----------------------------------------------------------------------------------
'//--- Tri via lignes colonnes - Autoformatage
'//----------------------------------------------------------------------------------
Call ee.autoformat(Sheet.Cells(3,1),Sheet.Cells(ligne,5),xlFormatClassic3)
Call ee.sortCells1(Sheet.Cells(3,1),Sheet.Cells(ligne,5),sheet.Cells(4,5))
Call ee.sortCells2(Sheet.Cells(3,1),Sheet.Cells(ligne,5),sheet.Cells(4,3),sheet.Cells(4,4))
Call ee.sortCells3(Sheet.Cells(3,1),Sheet.Cells(ligne,5),sheet.Cells(4,3),sheet.Cells(4,4),sheet.Cells(4,2))
Call ee.sortCells1(Sheet.Cells(3,1),Sheet.Cells(ligne,5),sheet.Range("D4"))
Call ee.sortCells2(Sheet.Cells(3,1),Sheet.Cells(ligne,5),sheet.Range("D4"),sheet.Range("C4"))
Call ee.sortCells3(Sheet.Cells(3,1),Sheet.Cells(ligne,5),sheet.Range("D4"),sheet.Range("C4"),sheet.Range("B4"))
'//----------------------------------------------------------------------------------
'//--- Tri selon RangeArea
'//----------------------------------------------------------------------------------
Call ee.sortRangeArea1("A4:E33",sheet.Cells(4,5))
Call ee.sortRangeArea2("A4:E33",sheet.Cells(4,3),sheet.Cells(4,4))
Call ee.sortRangeArea3("A4:E33",sheet.Cells(4,3),sheet.Cells(4,4),sheet.Cells(4,2))
Call ee.sortRangeArea1("A4:E33",sheet.Range("D4"))
Call ee.sortRangeArea2("A4:E33",sheet.Range("D4"),sheet.Range("C4"))
Call ee.sortRangeArea3("A4:E33",sheet.Range("D4"),sheet.Range("C4"),sheet.Range("B4"))
'//----------------------------------------------------------------------------------
'// Faire de la sélection de cellule
'//----------------------------------------------------------------------------------
XLApp.Range(Sheet.Cells(3,1), Sheet.Cells(ligne,5)).Select
XLApp.Selection.Font.Name = "Arial"
XLApp.Selection.Font.Size = 9
'//----------------------------------------------------------------------------------
'// Autre méthode et contraction de la sélection
'//----------------------------------------------------------------------------------
Set s=XLApp.Selection
s.Font.Name = "Arial"
s.Font.Size = 9
'//----------------------------------------------------------------------------------
'// Autofit deuxième méthode
'//----------------------------------------------------------------------------------
xlApp.Selection.Columns.AutoFit
'//----------------------------------------------------------------------------------
'// Mise en page première méthode
'//----------------------------------------------------------------------------------
With XLApp.Worksheets(1)
.PageSetup.Orientation = 2
.PageSetup.centerheader = "Liste des joueurs"
.Pagesetup.RightFooter = "Page : &P"
.Pagesetup.CenterFooter = "Saison 2005"
End With
'//----------------------------------------------------------------------------------
'// Largeur spécifique
'//----------------------------------------------------------------------------------
Call ee.WidthColumns("B",25)
Call ee.RowHeight(1,25)
'//----------------------------------------------------------------------------------
'// Sauvegarde de la feuille
'//----------------------------------------------------------------------------------
ee.SaveAs "c:\alpha\joueurs.xls"
'//----------------------------------------------------------------------------------
'// On ferme tout
'//----------------------------------------------------------------------------------
ee.CloseActiveWorkBook
ee.CloseSession
Exit Sub
Erreur:
Msgbox "Erreur " & Err & " " & Error$ & " ligne " & Erl
ee.CloseSession
Resume Fin
Fin:
End Sub
[/syntax]

Bonjour

Super complet ton code...
Mais une question : est-il possible de lancer une macro directement à partir de Notes (la macro étant déjà crée dans le document Excel).
Si oui, comment faire !!!

Merci d'avance.
Frédéric

Bonjour,

xlApp.Application.Run "LaMacro"

Merci Ogurama pour cette classe LS.

Par contre, il y a pas mal d'erreur de variable non déclarées.
Donc je te soumet 2 choses :
- utiliser Option Declare et traiter les variables non déclarées
- mettre la signature des propriétés, fonctions et procédures en début de classe avec un petit commentaire, pour rendre plus lisible.

Bonne continuation

oui en effet... j'ai fait du va-vite....
c'est une classe de travaille.... je laisse le choix à ceux qui la reprennent
pour les commentaires en début... j'y avais pensé... dommage que l'on pas les fonctions de java pour documenter une classe automatiquement

Le code est tres intéressant, mais je me pose unequestion : est il possible via lotus script d'appeler une feuille précise dans un classeur par son nom plutot que par son num d'index ?
Ex :
Si j'ai deux feuilles excel : Toto et Toto2 et que je veux envoyer des données dans la feulle Toto2, je dois faire un truc du style :
Set excelbook = excelapp.Workbooks(1).Worksheets(i)
où i est l'index de ma feuille Toto2.

Mais en passant par le nom cela ne marche pas :
Set excelbook = excelapp.Workbooks(1).Worksheets("toto2")
on a une erreur OLE....

Quelqu'un a une idée ?

Salut,

Perso j'utiliserais Sheets du style excelapp.Workbooks(1).Sheets("Toto2").Select

oulala, j'ai posté un peu trop vite, on peut appeler une feuille via son nom il y avait une erreur dans le code que j'avais tapé...
Pour me faire pardonner une petite astuce qui m'a ennervé pendant quelques heures :
comment faites vous quand vous créez une nouvelle feuille Excel via Lotus Script pour que celle ci se place en derniere position ?
On pense tout de suite à la méthode "move" oui mais, comment l'utiliser avec lotusscript ? voilà la réponse :

http://www-10.lotus.com/ldd/46dom.nsf/5 ... cel,brandt

j'ai testé, ça marche super !

ok ça marche