Vous trouverez ci-dessous une classe Word permettant par exemple de d'exporter une vue dans un document word soit en forme de tableau ou de liste comme le montre l'exemple joint à ce post
[syntax="ls"]
Option Public
'%INCLUDE "olewordconst.lss"
'/cet include sera joint dans un autre post
'/ REM ne pas oublier de supprimer les variables qui ne passent pas ou réduire leur nom
Use "WORDCONST"
Public Class WordSession
Private WApp As Variant
Private Documents As Variant
Private Document As Variant
Private ActiveDocument As Variant
Private Selection As Variant
Private LastParagraph As Variant
Private NewRangeStart As Long
'//--------------------------------------------------------------------
'// Constructeur
'//--------------------------------------------------------------------
Sub new
Call CreateSession()
End Sub
'//--------------------------------------------------------------------
'// Accès aux propriétés
'//--------------------------------------------------------------------
Function getSelection() As Variant
getSelection=Selection
End Function
Function getDocument() As Variant
getDocument=Document
End Function
Function getDocuments() As Variant
getDocuments=Documents
End Function
Function getActiveDocument() As Variant
getActiveDocument=ActiveDocument
End Function
Function getApplication() As Variant
getApplication=WApp
End Function
'//--------------------------------------------------------------------
'// Initialisation des objets nécessaires
'//--------------------------------------------------------------------
Private Sub initSession
'// Ajout d'un document vièrge fondé sur le normal.dot
WApp.Documents.Add
Set Documents=Wapp.Documents
Set Document=Documents(1)
Set ActiveDocument=WApp.ActiveDocument
Set Selection=WApp.Selection
End Sub
'//--------------------------------------------------------------------
'// Ouverture d'une session MS Word
'//--------------------------------------------------------------------
Private Function CreateSession() As Variant
On Error Goto CreateSession
'// On tente de récupérer une session existante
'// Si aucune session on l'instancie sur une génération d'erreur
Set WApp = GetObject("", "Word.Application")
CreateSessionOk:
Call initSession
Exit Function
CreateSession:
Err = 0
Print "Création de la session MS Word"
'// Création de la session Word
Set WApp = CreateObject("Word.Application")
'// Si impossible de la créer on force l'erreur
If WApp Is Nothing Then
Error 9999,"Impossibile d'initialiser la session MS Word"
Resume EndCreationSession
End If
Print "Session MS Word initialisée "
'// On sort proprement pour initialiser les objets
Resume CreateSessionOK
EndCreationSession:
End Function
Sub setDisplayAlerts(toggle As Integer)
WApp.DisplayAlerts=toggle
End Sub
Sub setVisible(toggle As Integer)
WApp.Visible=toggle
End Sub
'//---------------------------------------------------------------------------
'// Ajout d'un texte
'//----------------------------------------------------------------------------
Sub AppendText(text As String, newline As Integer)
Selection.TypeText(text)
If newline Then Selection.TypeParagraph
End Sub
'//--------------------------------------
'// Nouvelle ligne
'//--------------------------------------
Sub NewLine(n As Integer)
Dim i As Integer
For i=1 To n
Selection.TypeParagraph
Next
End Sub
'//--------------------------------------
'// Saut page ou de section
'//--------------------------------------
Sub InsertBreak(t As Integer)
Call Selection.InsertBreak(t)
End Sub
'//----------------------------------------
'// Orientation de la page
'//---------------------------------------
'// wdOrientLandscape=1
'// wdOrientPortrait=0
Sub Orientation(o As Integer)
With Selection.PageSetup
.Orientation = o
End With
End Sub
'//---------------------------------
'// Style de texte
'//---------------------------------
Sub Style(sn As Variant)
Selection.Style = sn
End Sub
'/////////////////////////////////////
'// liste des couleurs colorIndex
'// wdAuto
'// wdBlack
'// wdBlue
'// wdBrightGreen
'// wdByAuthor
'// wdDarkBlue
'// wdDarkRed
'// wdDarkYellow
'// wdGray25
'// wdGray50
'// wdGreen
'// wdNoHighlight
'// wdPink
'// wdRed
'// wdTeal
'// wdTurquoise
'// wdViolet
'// wdWhite
'// wdYellow
'////////////////////////////////////////////
'//---------------------------------------
'// ColorIndex
'//---------------------------------------
Sub FontColorIndex(color As Integer)
Selection.Font.ColorIndex = color
End Sub
'//---------------------------------------
'// Fonte
'//---------------------------------------
Sub FontName(n As String)
Selection.Font.Name = n
End Sub
'//-----------------------------------------
'// Taille des caractères
'//-----------------------------------------
Sub FontSize (fz As Integer)
Selection.Font.Size = fz
End Sub
'//--------------------------------------------
'// Gras
'//---------------------------------------------
Sub FontBold(toggle As Integer)
Selection.Font.Bold = Toggle
End Sub
'//------------------------------------------------------
'// Souligné
'//-------------------------------------------------------
Sub FontUnderline(toggle As Integer)
'wdUnderlineDashHeavy
'wdUnderlineDashLongHeavy
'wdUnderlineDotDashHeavy
'wdUnderlineDotDotDashHeavy
'wdUnderlineDottedHeavy
'wdUnderlineNone
'wdUnderlineThick
'wdUnderlineWavyDouble
'wdUnderlineWords
'wdUnderlineDash
'wdUnderlineDashLong
'wdUnderlineDotDash
'wdUnderlineDotDotDash
'wdUnderlineDotted
'wdUnderlineDouble
'wdUnderlineSingle
'wdUnderlineWavy
'wdUnderlineWavyHeavy
Selection.Font.Underline = toggle
End Sub
'//--------------------------------------------
'// Italic
'//--------------------------------------------
Sub FontItalic(toggle As Integer)
Selection.Font.Italic = Toggle
End Sub
'//--------------------------------------------
'// Italic
'//--------------------------------------------
Sub FontColor(color As Integer)
Selection.Font.Italic = color
End Sub
'//--------------------------------------------------------------------------
'// Texte dans un paragraphe
'//--------------------------------------------------------------------------
Function AddTextToDoc(text As String) As Variant
Dim doc As Variant
Set doc=document
Set lastParagraph = doc.Paragraphs(doc.Paragraphs.Count).Range
newRangeStart = lastParagraph.End-1 ' This is where the new text will be placed
Call lastParagraph.InsertAfter(text)
End Function
'//------------------------------------------------------------------
'// Centrage du texte
'//-----------------------------------------------------------------
Sub AlignCenterParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub
'//------------------------------------------------------------------
'// Cadrage à droite
'//-----------------------------------------------------------------
Sub AlignRightParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
End Sub
'//------------------------------------------------------------------
'// Cadrage à gauche
'//-----------------------------------------------------------------
Sub AlignLeftParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
End Sub
'//-----------------------------------------------------------------
'// Création d'un tableau
'//-----------------------------------------------------------------
Sub CreateTable(rows As Integer, cols As Integer)
Call ActiveDocument.Tables.Add(Selection.Range,rows,cols)
End Sub
'//-----------------------------------------------------------------
'// Largeur des d'une colonne d'un tableau
'//-----------------------------------------------------------------
Sub SetTableColumnWidth(t As Integer, c As Integer, w As Single)
Dim table As Variant
Dim column As Variant
Set table=ActiveDocument.Tables(t)
Set column = table.Columns(c)
column.PreferredWidthType = 3
column.Width = WApp.CentimetersToPoints(w)
End Sub
'//-----------------------------------------------------------------
'// Hauteur d'une ligne d'un tableau
'//-----------------------------------------------------------------
Sub SetTableColumnHeight(t As Integer, r As Integer, h As Single)
'wdRowHeightAtLeast=1
'wdRowHeightAuto=0
'wdRowHeightExactly=2
Dim table As Variant
Dim row As Variant
Set table=ActiveDocument.Tables(t)
Set row = table.Rows(r)
Row.HeightRule = 2
Row.Height = WApp.CentimetersToPoints(h)
End Sub
'/////////////////////////////////////////
'// Unités de déplacement
'// wdLine
'// wdParagraph
'// wdWindow
'// wdScreen
'// wdCell
'// wdSentence
'// wdSection
'// wdStory
'/////////////////////////////////////////
'//----------------------------------------------------------------
'// Déplacement à droite
'//-----------------------------------------------------------------
Sub MoveRight(u As Integer, n As Integer, e As Integer)
Call Selection.MoveRight(u,n,e)
End Sub
'//----------------------------------------------------------------
'// Homekey
'//-----------------------------------------------------------------
Sub HomeKey(u As Integer,e As Integer)
Call Selection.HomeKey(u)
End Sub
'//----------------------------------------------------------------
'// EndKey
'//-----------------------------------------------------------------
Sub EndKey(u As Integer,e As Integer)
Call Selection.EndKey(u,e)
End Sub
'//--------------------------------------------------------------------
'// Déplacement à gauche
'//-------------------------------------------------------------------
Sub MoveLeft(u As Integer,n As Integer,e As Integer)
Call Selection.MoveLeft(u,n,e)
End Sub
'//--------------------------------------------------------------------
'// Déplacement vers la fin
'//-------------------------------------------------------------------
Sub MoveEnd(u As Integer,n As Integer)
Call Selection.MoveEnd(u,n)
End Sub
'//--------------------------------------------------------------------
'// Déplacement vers le début
'//-------------------------------------------------------------------
Sub MoveStart(u As Integer,n As Integer)
Call Selection.MoveStart(u,n)
End Sub
'//--------------------------------------------------------------------
'// Déplacement vers le bas
'//-------------------------------------------------------------------
Sub MoveDown(u As Integer,n As Integer,e As Integer)
Call Selection.MoveDown(u, n,e)
End Sub
'//--------------------------------------------------------------------
'// Déplacement vers le haut
'//-------------------------------------------------------------------
Sub MoveUp(u As Integer,n As Integer,e As Integer)
Call Selection.MoveUp(u, n, e)
End Sub
'//--------------------------------------------------------------------
'// Taquet de tabulation positionné
'//-------------------------------------------------------------------
Sub TabStop(p As Single)
Call Selection.ParagraphFormat.TabStops.Add(WApp.CentimetersToPoints(p))
End Sub
'//--------------------------------------------------------------------
'// Taquet de tabulation effacé
'//-------------------------------------------------------------------
Sub TabStopClear(p As Single)
Call Selection.ParagraphFormat.TabStops(WApp.CentimetersToPoints(2)).Clear
End Sub
'//--------------------------------------------------------------------
'// Enregistrement du document
'//-------------------------------------------------------------------
Sub saveAs(fn As String)
Activedocument.SaveAs fn
End Sub
Sub Save
ActiveDocument.Save
End Sub
'//--------------------------------------------------------------------
'// Fermeture d'une session MS Word
'//--------------------------------------------------------------------
Sub QuitSession
On Error Goto CreateSession
Set WApp = GetObject("", "Word.Application")
ExistSessionOK:
WApp.Quit
Print "Session MS Word terminée"
Exit Sub
CreateSession:
Err = 0
WApp = CreateObject("Word.Application")
If WApp Is Nothing Then
Error 9999,"Impossibile d'initialiser la session MS Word"
Resume EndCloseSession
End If
Resume ExistSessionOK
EndClosesession:
End Sub
End Class
[/syntax]
un exemple d'utilisation.... ne pas oublier de récupérer la liste des constantes que je viens de mettre à jour dans cette rubrique
[syntax="ls"]
Option Public
Use "ClassWord"
Sub Initialize
Dim word As WordSession
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As notesdocument
On Error Goto erreur
Set db = session.Currentdatabase
Set view=db.Getview("By number")
Set word=New wordsession
Call word.setVisible(True)
Call word.setDisplayAlerts(False)
Call word.FontBold(True)
Call word.FontItalic(True)
Call word.FontSize(14)
Call word.FontColorIndex(wdBlue)
Call word.FontName("Tahoma")
Call word.FontUnderline(wdUnderlineDouble )
Call word.AlignCenterParagraph
Call word.AppendText("Liste des joueurs",True)
Call word.Style("Normal")
Call word.NewLine(2)
Call word.CreateTable(1,3)
Call word.SetTableColumnWidth(1,1,1)
Call word.SetTableColumnWidth(1,2,10)
Call word.SetTableColumnWidth(1,3,2)
Call word.MoveRight(wdCharacter,3,wdExtend)
Call word.FontBold(True)
Call word.FontColorIndex(wdDarkRed)
Call word.AppendText("N°",False)
Call word.MoveRight(wdCell,1,wdMove)
Call word.AppendText("Nom",False)
Call word.MoveRight(wdCell,1,wdMove)
Call word.AppendText("Position",False)
Call word.MoveRight(wdCell,1,wdMove)
Call word.MoveRight(wdCharacter,3,wdExtend)
Call word.FontBold(False)
Call word.FontSize(10)
Call word.FontName("Arial")
Call word.FontColorIndex(wdDarkBlue)
Set doc = view.GetFirstDocument
While Not doc Is Nothing
Call word.AppendText(Cstr(doc.number(0)),False)
Call word.MoveRight(wdCell,1,wdMove)
Call word.AppendText(doc.name(0),False)
Call word.MoveRight(wdCell,1,wdMove)
Call word.AppendText(doc.Position(0),False)
Set doc=view.getnextdocument(doc)
If Not doc Is Nothing Then Call word.MoveRight(wdCell,1,wdMove)
Wend
Call word.MoveDown(wdLine,1,wdMove)
Call word.Style("Normal")
Call word.NewLine(1)
'// Présentation avec tabulation
'// =======================
Call word.FontBold(True)
Call word.FontItalic(True)
Call word.FontSize(16)
Call word.FontColorIndex(wdBlue)
Call word.FontName("Verdana")
Call word.FontUnderline(wdUnderlineDouble )
Call word.AlignCenterParagraph
Call word.AppendText("Liste des joueurs",True)
Call word.Style("Normal")
Call word.NewLine(2)
Call word.TabStop(1.5)
Call word.TabStop(11)
Call word.FontBold(True)
Call word.FontColorIndex(wdDarkRed)
Call word.FontUnderline(wdUnderlineDouble )
Call word.FontName("Tahoma")
Call word.AppendText("N°" & Chr$(9) & "Nom" & Chr$(9) & "Position",True)
Call word.FontUnderline(wdUnderlineNone )
Call word.FontBold(False)
Call word.FontColorIndex(wdDarkBlue)
Call word.FontName("Arial")
Set doc = view.GetFirstDocument
While Not doc Is Nothing
Call word.Newline(1)
Call word.AppendText(Cstr(doc.number(0)) & Chr$(9) ,False)
Call word.AppendText(doc.name(0) & Chr$(9) ,False)
Call word.AppendText(doc.Position(0),False)
Set doc=view.getnextdocument(doc)
Wend
Call word.Newline(1)
Call word.TabStopClear(1.5)
Call word.TabStopClear(11)
Call word.Style("Normal")
Call word.SaveAs("c:\alpha\notes2word.doc")
'Call w.QuitSession
Exit Sub
erreur:
Msgbox "Err " & Err & " " & Error$ & " ligne " & Erl
Resume fin
fin:
End Sub
[/syntax]