 Thierry
Seunevel |
Code en stock |
|
| | Le code Lotusscript de la classe |
La bibliothèque ExcelReport se compose exclusivement de la section Déclarations présentée et commentée ci-dessous.
|
| |
Class ExcelReport
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' propriétés
' linefield (set) nom plage définissant la ligne courante, défaut=reportline
' rangenames (get) liste des noms définis
' rangevalue (get) retourne contenu plage nommée
' sheet (set) nom feuille cible et source des échanges. par défaut, 1ere
' méthodes
' initheader définition en-tete document excel à partir document notes
' fillreportline définition contenu une ligne courante depuis un document notes
' closereport clos la génération du document excel (appel auto si besoin)
' printout impression document excel
' saveas sauvegarde classeur sous le nom passé en paramètre
' preview affiche docuemnt excel en prévisualisation
' delete détruit objet et objets associés
' new instancie objet suivant modèle dont nom est passé en parm
' insertpgbreak insére un saut de page
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
|
 |
Private xlApp As Variant
Private xlSheet As Variant
Private xlRange As Variant
Private xlRange0 As Variant
Private xlWRange As Variant
Private xlNames As Variant
Private lgCol As Long
Private lineCount As Integer
Private colFields() As String
Private nbCols As Integer
Private firstCol As Long
Private lineFieldName As String
Private sheetName As String
Private reportInitialized As Integer
Private colNumberUsed As Integer
Private colNumberDefined As Integer
Private reportClosed As Integer
Private modelRow As Integer
|
 |
Sub New(ModelFile As String)
Set xlApp=createObject("excel.application")
xlApp.visible=False
xlApp.Workbooks.Open ModelFile
lineFieldName="reportline" ' nom par défaut de la ligne modèle
End Sub
Property Set lineField As String
'""""""""""""-------------"""""""""""""""""""""""""
' permet d'imposer un nom pour la ligne modèle de détail
' par défaut, nom = reportline
' si *none, pas de ligne détail
'""""""""""""""""""""""""""""""""""""""""""""""
linefieldname=linefield
end property |
 |
Property Get RangeValue(rgName As String) As Variant
'"""""""""""""---------------------------------""""""""""""""""""""
' lecture des valeurs contenues dans la plage nommée rgname
' si plage de + d'une cellule, retour d'un tableau
'-------------------------------------------------------------------------
dim wrange as variant,wresult as variant
dim nbcols as long,nbrows as long, r as integer,c as integer, x as integer
if not reportinitialized then initreport
on error resume next
set wrange=xlnames(rgname).referstorange()
if err<>0 Then Exit Property
On Error Goto 000
nbCols=wRange.Columns.count
nbRows=wRange.Rows.count
If ( nbCols * nbRows) = 1 Then
wResult=wRange.Cells(1,1).Value
Else
Redim wResults((nbCols * nbRows)-1)
For c=1 To nbCols
For r=1 To nbRows
wResult(x)=wRange.cells(r,c).Value
x=x+1
Next
Next
End If
RangeValue=wResult
End Property
Property Get rangeNames As Variant
'"""""""""""""""""-------"""""""""""""""""""""""""""""""
' Retourne tableau des noms définis
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""
dim snames() as string
dim ix as integer
if not reportinitialized then initreport
redim snames(xlnames.count - 1)
forall nm in xlnames
snames(ix) = nm.name
ix = ix + 1
end forall
rangenames = snames
end property
property set sheet as string
'""""""""""""----------""""""""""""""""""""""""""""""""""
' permet d'imposer un nom pour la feuille source et cible des échanges
' par défaut, 1ere feuille du classeur utilisée
'""""""""""""""""""""""""""""""""""""""""""""""""""""
sheetname=sheet
end property
|
 |
Public Sub initHeader(aDoc As notesDocument)
'"""""""-----------------"""""""""""""""""""""""""
' Initialisation de champs d'en-tete en fonction de noms de champs
' du modèle XLS, et du contenu d'un document d'entête.
' si initReport n'a pas été exécuté, exécution
'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim sName As String
Dim vValue
If Not reportInitialized Then initReport
Forall nm In xlNames
sName = nm.Name
If Instr(sName , "!") = 0 Then
Err =0
On Error Resume Next
Set xlWRange=nm.refersToRange()
If Err = 0 And xlWRange.Row <> modelRow Then
If aDoc.hasItem(sName) Then
vValue = aDoc.getItemValue(sName)(0)
If vValue <> "" Then
xlWRange.Cells(1,1).Value=vValue
End If
End If
End If
End If
End Forall
End Sub
|
 |
Public Function fillReportLine(aDoc As NotesDocument) As Integer
'""""""""""" --------------------- """"""""""""""""""""""""""""""""""
' remplit ligne courante document excel, retourne numéro de ligne courant
'-------------------------------------------------------------------------
dim sname as string
dim vvalue
if not reportinitialized then initreport
if colnumberused and not colnumberdefined then defcolnumbers adoc
linecount=linecount+1
if linecount=1 then
set xlrange=xlrange.offset(-1,0)
else
xlrange.insert ' insérer ligne pour prochain document
set xlrange=xlrange.offset(-1,0)
end if
xlrange0.copy(xlrange)
for lgcol=1 to xlrange.columns.count
sname = colfields(lgcol-1)
if sname <> "" Then
If Left$(sName, 1) = "#" Then
vValue = aDoc.ColumnValues(Cint(Right$(sName, Len(sName) -1)))
Else
vValue = aDoc.getItemValue(sName)(0)
End If
If vValue <> "" Then xlRange.Cells(1,lgCol).Value = vValue
End If
Next
Set xlWrange=xlRange
Set xlRange=xlRange.offset(1,0)
fillReportLine=lineCount
End Function
|
 |
Public Sub printOut
'"""""""--------------""""""""""""""""""""""""""""""""""""
' appel impression document closereport appelé si besoin
'""""""""""""""""""""""""""""""""""""""""""""""""""""
if not reportclosed then closereport
xlsheet.printout
end sub
public sub preview
'"""""""--------------""""""""""""""""""""""""""""""""""""
' Appel visualisation écran (aperçu avant impression)
'""""""""""""""""""""""""""""""""""""""""""""""""""""
If Not ReportClosed Then closeReport
xlApp.visible=True
xlSheet.printPreview
End Sub
'""""""""""-------------------------"""""""""""""""""""""""""""
public sub insertpgbreak()
xlwrange.pagebreak = 1
end sub
|
 |
Public Sub saveAs(fileName As String)
'"""""""""""-----------""""""""""""""""""""""""""""""""""""
if not reportclosed then closereport
on error resume next
xlsheet.saveas filename
end sub
public sub closereport
'"""""""--------------------"""""""""""""""""""""""""""""""""""""""""""""""
' routine fermant l'état en cours. appelée automatiquement si besoin
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
If lineCount>0 Then
xlRange.Delete
Set xlRange=xlWRange.offset(1,0)
For lgCol=1 To xlWRange.Columns.count
xlRange.Cells(1,lgCol).Value=xlWRange.Cells(1,lgCol).Value
Next
xlWRange.delete
End If
ReportClosed=True
End Sub
Public Sub Delete
'"""""""""""""""""""
if not xlsheet is nothing then xlapp.activeworkbook.close false
if not xlapp is nothing then xlapp.quit
set xlapp=nothing
end sub
|
 |
Private Sub initReport()
'-------------------------------------------------------------------
' initialisation champs détail : liste des champs de la ligne détail
'-------------------------------------------------------------------
Dim sName As String
If sheetName <> "" Then
Set xlSheet = xlApp.Workbooks(1).Worksheets(sheetName)
Else
Set xlSheet = xlApp.Workbooks(1).Worksheets(1)
End If
Set xlNames=xlApp.Workbooks(1).Names
If LineFieldName<>"*none" Then
Set xlRange=xlNames(LINEFIELDNAME).refersToRange()
Set xlRange0=xlRange
modelRow=xlRange.Row
firstCol=xlRange.column
nbCols=xlRange.Columns(xlRange.Columns.Count).Column - firstCol + 1
Redim colFields(nbCols-1)
Forall nm In xlNames
sName = nm.Name
If Instr(sName , "!") = 0 Then
Set xlWRange=nm.refersToRange()
If Ucase$(sName) <> LINEFIELDNAME And xlWRange.Row = modelRow Then
If Ucase$(Mid$(sName, 2 ,4)) = "col." Then
If Isnumeric(Right$(sName, Len(sName) - 5)) Then
If Ucase$(Left$(sName, 1)) = "v" Then
colFields(xlwRange.Column-firstCol)="*v" & Right$(sName, Len(sName)-5)
Else
colFields(xlwRange.Column-firstCol)="*a" & Right$(sName, Len(sName)-5)
End If
colNumberUsed = True
End If
Else
colFields(xlwRange.Column - firstCol) = sName
End If
End If
End If
End Forall
End If
reportInitialized=True
End Sub
|
 |
Private Sub defColNumbers(doc As NotesDocument)
'"""""""""""""""""""""""""""""""""""""
dim vw as notesview
dim diff() as integer, nbr as integer, ix as integer
set vw = doc.parentview
if vw is nothing then
exit sub
end if
redim diff(vw.columncount - 1)
forall col in vw.columns
if col.ishidden then nbr = nbr + 1
diff(ix) = nbr
ix = ix + 1
end forall
for ix = 0 to ubound(colfields)
if left$(colfields(ix), 1) = "*" then
nbr = cint(right$(colfields(ix) ,len(colfields(ix)) - 2)) -1
if mid$(colfields(ix), 2, 1) = "V" then nbr = nbr + diff(nbr)
if nbr <= ubound(diff) then
colfields(ix) = "#" & cstr(nbr)
else
colfields(ix) = ""
end if
end if
next
colnumberdefined = true
end sub
end class
|
|
- Section de déclaration des variables privées de la classe. Ces variables ne sont pas accessibles depuis l'extérieur de la classe.
- La fonction New instancie un nouvel objet de la classe ExcelReport en créant un objet OLE de type Excel, en le rendant non visible, et en copiant dans cet objet le fichier Excel modèle dont le nom a été fourni en paramètre.
On donne aussi au nom de plage de la ligne courante de l'état sa valeur par défaut, REPORTLINE.
- Comme plusieurs autres fonctions, rangeValue fait appel à la fonction interne initReport si la variable reportInitialized n'est pas égale à vrai.
La fonction ignore toutes les erreurs pour éviter tout problème de type de données.
Les lignes et colonnes correspondant à la plage nommée sont ensuite parcourus et le contenu de chaque cellule est ajoutée comme élément supplémentaire à une variable de type variant qui est ensuite retournée à la fonction appelante.
- initHeader exécute tout d'abord si nécessaire la fonction initReport, puis parcourt la liste des noms définis dans Excel, en excluant ceux dont le nom contient un ! (noms spéciaux Excel).
Pour chacun, et à condition qu'il ne fasse pas partie des champs de la ligne détail, si le document Notes contient un champ de même nom avec un contenu non vide, le contenu du champ est transféré dans la cellule Excel (si champ multi-valeurs, seule la première valeur est prise en compte).
- Le remplissage d'une ligne détail effectue une copie de la plage modèle à l'emplacement d'insertion pour hériter des formules.
Si des numéros de colonnes de vue ont été définis, le premier appel de fillReportLine traite les données mises en réserve, en accèdant à la vue parente du document reçu en paramètre.
On parcourt le tableau constitué dans initReport et qui assoocie chaque colonne à un nom de cellule. Si le nom de champ mémorisé = #x, on accède aux données de la colonne x.
Si le document Notes reçu en paramètre contient un champ de même nom non vide, sa valeur est placée dans la cellule Excel correspondante.
On met en réserve la plage courante, et on retourne le numéro de ligne courante.
- printOut comme preView font appel à la fonction closeReport si cette fonction n'a pas encore été exécutée, puis au verbe OLE permettant d'afficher ou d'imprimer le fichier Excel (feuille désignée par la propriété sheet ou 1ere feuille du classeur.
- La procédure de sauvegarde fait appel au verbe OLE de même nom. Les erreurs sont ignorées, en particulier pour éviter un message si l'utilisateur annule la demande de sauvegarde.
- La procédure privée initReport est appelée automatiquement la première fois que son exécution est requise.
Elle a comme principale fonction d'analyser la plage nommée définissant la ligne détail, et de construire un tableau des noms associés à chaque colonne dans cette plage.
Quand le nom de plage est égal à aCol ou vCol, ce nom est remplacé par une valeur conventionnelle (*A ou *V). Dans ce cas, l'initialisation doit être différée, les informations concernant la vue source doivent en effet être accédées depuis le premier document détail transmis à la méthode fillReportLine.
- La procédure privée defColNumbers est appelée au premier appel de la méthode fillReportLine, et reçoit en paramètre le premier document détail. Son rôle est de calculer le numéro de colonne effectif pour les noms définis par référence aux colonnes visibles.
|
|
|
|
| © Thierry Seunevel (2004) |
www.seusoft.com |
|
|
|
|
