Classe Word V 2.0
Vous trouverez ci-dessous une version 2 de la classe Word
Elle intègre de nouvelles méthodes et propriétés.
Elle permet de gérer plusieurs documents en ligne.
Je vous laisse découvrir ses nouveautés.
Elle est perfectible.
Là où j'ai eu de la misère c'est pour le header et footer de page.
Si quelqu'un a mieux, je suis preneur.
[syntax="ls"]
Public Class WordSession
Private WApp As Variant
Private Documents As Variant
Private Document As Variant
Private ActiveDocument As Variant
Private Windows As Variant
Private Window As Variant
Private ActiveWindow As Variant
Private Selection As Variant
Private Sections As Variant
Private Section As Variant
'//--------------------------------------------------------------------
'// Constructeur
'//--------------------------------------------------------------------
Sub new()
Call CreateSession
End Sub
'//--------------------------------------------------------------------
'// Accès aux propriétés
'//--------------------------------------------------------------------
Function getSelection() As Variant
Set getSelection=Selection
End Function
Function getDocument() As Variant
Set getDocument=Document
End Function
Function getDocuments() As Variant
Set getDocuments=Documents
End Function
Function getActiveDocument() As Variant
Set getActiveDocument=ActiveDocument
End Function
Function getApplication() As Variant
Set getApplication=WApp
End Function
Function getSections() As Variant
Set getSections=Sections
End Function
'//------------------------------------------------------------------
'// Ajout d'un nouveau document
'//-----------------------------------------------------------------
Public Sub AddNewDocument(template As String)
If template="" Then
WApp.Documents.Add
Else
WApp.Documents.Add(template)
End If
Set Documents=Wapp.Documents
Set Windows=WApp.Windows
Call ActivateDocument(Documents.Count)
End Sub
'//--------------------------------------------------------------------------------------------
'// Rend actif le document n ou le dernier document créé
'//--------------------------------------------------------------------------------------------
Public Sub ActivateDocument(n As Integer)
'// A priori ça ne devrait pas se produire, mais ?
If n>Documents.Count Then
Error 9999,"Impossible d'activer le document " & n
End If
If n=0 Then
Error 9999,"Aucun document monté en mémoire"
End If
Set Document=Documents(n)
Document.Activate
Set ActiveDocument=WApp.ActiveDocument
Set Sections=ActiveDocument.Sections
Set Window=Windows(n)
Window.Activate
Set ActiveWindow=Wapp.ActiveWindow
Set Selection=Window.Selection
Windows(n).Activate
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:
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
'//--------------------------------
'// Coller
'//--------------------------------
Sub Past()
WApp.Selection.Paste
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
'//-------------------------------------------------------------------------
'// Gestion des bordures de cadres
'//-------------------------------------------------------------------------
Sub BorderAll(lw As Integer, ls As Integer, t As Integer, b As Integer, r As Integer, l As Integer, ts As Integer)
'wdLineWidth025pt=2, 'wdLineWidth050pt=4
'wdLineWidth075pt=6, 'wdLineWidth100pt=8
'wdLineWidth150pt=12, 'wdLineWidth225pt=18
'wdLineWidth300pt=24, 'wdLineWidth450pt=36
'wdLineWidth600pt=48, 'wdLineStyleDashDot=5
'wdLineStyleDashDotDot=6, 'wdLineStyleDashDotStroked=20
'wdLineStyleDashLargeGap=4, 'wdLineStyleDashSmallGap=3
'wdLineStyleDot=2, 'wdLineStyleDouble=7
'wdLineStyleDoubleWavy=19, 'wdLineStyleEmboss3D=21
'wdLineStyleEngrave3D=22, 'wdLineStyleNone=0
'wdLineStyleSingle=1, 'wdLineStyleSingleWavy=18
'wdLineStyleThickThinLargeGap=16, 'wdLineStyleThickThinMedGap=13
'wdLineStyleThickThinSmallGap=10, 'wdLineStyleThinThickLargeGap=15
''wdLineStyleThinThickMedGap=12, 'wdLineStyleThinThickSmallGap=9
'wdLineStyleThinThickThinLargeGap=17, 'wdLineStyleThinThickThinMedGap=14
'wdLineStyleThinThickThinSmallGap=11,'ls=wdLineStyleSingle
With Selection.ParagraphFormat
If l Then
With .Borders(wdBorderLeft)
.LineStyle = ls
.LineWidth = lw
.Color = wdBlue
End With
End If
If r Then
With .Borders(wdBorderRight)
.LineStyle = ls
.LineWidth = lw
.Color = wdBlue
End With
End If
If t Then
With .Borders(wdBorderTop)
.LineStyle = ls
.LineWidth = lw
.Color = wdBlue
End With
End If
If b Then
With .Borders(wdBorderBottom)
.LineStyle = ls
.LineWidth = lw
.Color = wdBlue
End With
End If
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = ts
End With
End With
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
Sub InsertRowsBelow(n As Integer)
Call Selection.InsertRowsBelow(n)
End Sub
Sub InsertRowsAbove(n As Integer)
Call Selection.InsertRowsAbove(n)
End Sub
Sub SelectRow
Selection.SelectRow
End Sub
Sub SelectColumn
Selection.SelectColumn
End Sub
Sub RowDelete
Selection.Rows.Delete
End Sub
Sub SelectTable(n As Integer)
Selection.Tables(n).Select
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
'//-----------------------------------------------------------------
'// Lire le contenu d'une cellule d'un tableau
'//-----------------------------------------------------------------
Function GetTableCell(t As Integer, row As Long, col As Long) As Variant
Set GetTableCell=ActiveDocument.Tables(t).Cell(row,col)
End Function
'/////////////////////////////////////////
'// u = inité de déplacement
'// n = nombre de fois
'// e = extension de la sélection
'//////////////////////////////////////////
'/////////////////////////////////////////
'// 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
'//--------------------------------------------------------------------
'// BackSpace
'//-------------------------------------------------------------------
Sub BackSpace(n As Integer,e As Integer)
Call Selection.TypeBackspace(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(p)).Clear
End Sub
'//------------------------------------------------------------------------
'// Ajouter un signet
'//------------------------------------------------------------------------
Public Sub AddBookmark ( bookmark As String)
Call Document.Bookmarks.Add (bookmark)
End Sub
'//---------------------------------------------------------------------------
'// Remplacer le texte d'un signet
'//---------------------------------------------------------------------------
Public Sub UpdateTextBookmark (bookmark As String, value As String)
ActiveDocument.Bookmarks(bookmark).Range.Text=value
End Sub
'//---------------------------------------------------------------------------
'// Remplacer le texte d'un signet juste après
'//---------------------------------------------------------------------------
Public Sub InsertAfterBookmark (bookmark As String, value As String)
ActiveDocument.Bookmarks(bookmark).Range.InsertAfter(value)
End Sub
'//---------------------------------------------------------------------------
'// Supprimer un signet
'//---------------------------------------------------------------------------
Public Sub DeleteBookmark (bookmark As String)
ActiveDocument.Bookmarks(bookmark).Delete
End Sub
'//-----------------------------------------------------------------------
'// Selectionner un signet
'//------------------------------------------------------------------------
Sub GotoBookmark(bookmark As String)
ActiveDocument.Bookmarks(bookmark).Select
End Sub
'//-----------------------------------------------------------------------
'// Nombre de signets
'//------------------------------------------------------------------------
Function getBoorkmarks() As Integer
getBoorkmarks=ActiveDocument.Bookmarks.Count
End Function
'//-----------------------------------------------------------------------
'// Tester existance d'un signet
'//------------------------------------------------------------------------
Function ExistBookmark(bookmark As String) As Integer
ExistBookmark=ActiveDocument.Bookmarks.Exists(bookmark)
End Function
'//-----------------------------------------------------------------------
'// Affiche les signets
'//------------------------------------------------------------------------
Sub ShowBookmarks(toggle As Integer)
ActiveWindow.View.ShowBookmarks = toggle
End Sub
'//---------------------------------------------------------------------------
'// Mise à jour d'un champ
'//---------------------------------------------------------------------------
Public Sub UpdateField (field As String, value As String)
Document.FormFields(field).result = value
End Sub
'//--------------------------------------------------------------------
'// Enregistrement du document
'//-------------------------------------------------------------------
Sub saveAs(fn As String)
Activedocument.SaveAs fn
End Sub
Sub Save
ActiveDocument.Save
End Sub
'//----------------------------------------
'// Ferme le document
'//----------------------------------------
Sub CloseDocument(toogle)
Call Document.Close(toogle)
End Sub
'//--------------------------------------------------------------------
'// Appeler une macro
'//--------------------------------------------------------------------
Sub RunMacro(macro As String)
WApp.Run("[" & macro & "]")
End Sub
'//----------------------------------------
'// Entête de page
'//----------------------------------------
Sub SetHeader(t1 As String, t2 As String, t3 As String)
Dim Paragraph As Variant
Dim header As Variant
Dim p As Long
Set Section=document.Sections(1)
Set header = section.Headers(1)
Set Paragraph = header.Range
Call Paragraph.InsertBefore(t1 & Chr$(9) & t2 & Chr$(9) & t3)
Call showHeader
End Sub
'//-------------------------------------
'// Bas de page
'//------------------------------------
Sub SetFooter(t1 As String, t2 As String, t3 As String)
Dim Paragraph As Variant
Dim footer As Variant
Dim p As Long
Set Section=document.Sections(1)
Set footer = section.Footers(1)
Set Paragraph = footer.Range
Call Paragraph.InsertBefore(t1 & Chr$(9) & t2 & Chr$(9) & t3 & Chr$(9))
Set Paragraph = footer.Range
p = Paragraph.End
Call Paragraph.SetRange(p, p)
Call Paragraph.Fields.Add(Paragraph, 33)
Set Paragraph = footer.Range
p = Paragraph.End
Call Paragraph.SetRange(p, p)
Call Paragraph.InsertBefore("/")
Set Paragraph = footer.Range
p = Paragraph.End
Call Paragraph.SetRange(p, p)
Call Paragraph.Fields.Add(Paragraph, 26)
Call showHeader
End Sub
Private Sub showHeader
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
Private Sub initPanes
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
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
Public Class ExportToWord As WordSession
Sub new (template As String)
Call AddNewDocument(template)
End Sub
End Class
[/syntax]
Elle intègre de nouvelles méthodes et propriétés.
Elle permet de gérer plusieurs documents en ligne.
Je vous laisse découvrir ses nouveautés.
Elle est perfectible.
Là où j'ai eu de la misère c'est pour le header et footer de page.
Si quelqu'un a mieux, je suis preneur.
[syntax="ls"]
Public Class WordSession
Private WApp As Variant
Private Documents As Variant
Private Document As Variant
Private ActiveDocument As Variant
Private Windows As Variant
Private Window As Variant
Private ActiveWindow As Variant
Private Selection As Variant
Private Sections As Variant
Private Section As Variant
'//--------------------------------------------------------------------
'// Constructeur
'//--------------------------------------------------------------------
Sub new()
Call CreateSession
End Sub
'//--------------------------------------------------------------------
'// Accès aux propriétés
'//--------------------------------------------------------------------
Function getSelection() As Variant
Set getSelection=Selection
End Function
Function getDocument() As Variant
Set getDocument=Document
End Function
Function getDocuments() As Variant
Set getDocuments=Documents
End Function
Function getActiveDocument() As Variant
Set getActiveDocument=ActiveDocument
End Function
Function getApplication() As Variant
Set getApplication=WApp
End Function
Function getSections() As Variant
Set getSections=Sections
End Function
'//------------------------------------------------------------------
'// Ajout d'un nouveau document
'//-----------------------------------------------------------------
Public Sub AddNewDocument(template As String)
If template="" Then
WApp.Documents.Add
Else
WApp.Documents.Add(template)
End If
Set Documents=Wapp.Documents
Set Windows=WApp.Windows
Call ActivateDocument(Documents.Count)
End Sub
'//--------------------------------------------------------------------------------------------
'// Rend actif le document n ou le dernier document créé
'//--------------------------------------------------------------------------------------------
Public Sub ActivateDocument(n As Integer)
'// A priori ça ne devrait pas se produire, mais ?
If n>Documents.Count Then
Error 9999,"Impossible d'activer le document " & n
End If
If n=0 Then
Error 9999,"Aucun document monté en mémoire"
End If
Set Document=Documents(n)
Document.Activate
Set ActiveDocument=WApp.ActiveDocument
Set Sections=ActiveDocument.Sections
Set Window=Windows(n)
Window.Activate
Set ActiveWindow=Wapp.ActiveWindow
Set Selection=Window.Selection
Windows(n).Activate
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:
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
'//--------------------------------
'// Coller
'//--------------------------------
Sub Past()
WApp.Selection.Paste
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
'//-------------------------------------------------------------------------
'// Gestion des bordures de cadres
'//-------------------------------------------------------------------------
Sub BorderAll(lw As Integer, ls As Integer, t As Integer, b As Integer, r As Integer, l As Integer, ts As Integer)
'wdLineWidth025pt=2, 'wdLineWidth050pt=4
'wdLineWidth075pt=6, 'wdLineWidth100pt=8
'wdLineWidth150pt=12, 'wdLineWidth225pt=18
'wdLineWidth300pt=24, 'wdLineWidth450pt=36
'wdLineWidth600pt=48, 'wdLineStyleDashDot=5
'wdLineStyleDashDotDot=6, 'wdLineStyleDashDotStroked=20
'wdLineStyleDashLargeGap=4, 'wdLineStyleDashSmallGap=3
'wdLineStyleDot=2, 'wdLineStyleDouble=7
'wdLineStyleDoubleWavy=19, 'wdLineStyleEmboss3D=21
'wdLineStyleEngrave3D=22, 'wdLineStyleNone=0
'wdLineStyleSingle=1, 'wdLineStyleSingleWavy=18
'wdLineStyleThickThinLargeGap=16, 'wdLineStyleThickThinMedGap=13
'wdLineStyleThickThinSmallGap=10, 'wdLineStyleThinThickLargeGap=15
''wdLineStyleThinThickMedGap=12, 'wdLineStyleThinThickSmallGap=9
'wdLineStyleThinThickThinLargeGap=17, 'wdLineStyleThinThickThinMedGap=14
'wdLineStyleThinThickThinSmallGap=11,'ls=wdLineStyleSingle
With Selection.ParagraphFormat
If l Then
With .Borders(wdBorderLeft)
.LineStyle = ls
.LineWidth = lw
.Color = wdBlue
End With
End If
If r Then
With .Borders(wdBorderRight)
.LineStyle = ls
.LineWidth = lw
.Color = wdBlue
End With
End If
If t Then
With .Borders(wdBorderTop)
.LineStyle = ls
.LineWidth = lw
.Color = wdBlue
End With
End If
If b Then
With .Borders(wdBorderBottom)
.LineStyle = ls
.LineWidth = lw
.Color = wdBlue
End With
End If
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = ts
End With
End With
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
Sub InsertRowsBelow(n As Integer)
Call Selection.InsertRowsBelow(n)
End Sub
Sub InsertRowsAbove(n As Integer)
Call Selection.InsertRowsAbove(n)
End Sub
Sub SelectRow
Selection.SelectRow
End Sub
Sub SelectColumn
Selection.SelectColumn
End Sub
Sub RowDelete
Selection.Rows.Delete
End Sub
Sub SelectTable(n As Integer)
Selection.Tables(n).Select
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
'//-----------------------------------------------------------------
'// Lire le contenu d'une cellule d'un tableau
'//-----------------------------------------------------------------
Function GetTableCell(t As Integer, row As Long, col As Long) As Variant
Set GetTableCell=ActiveDocument.Tables(t).Cell(row,col)
End Function
'/////////////////////////////////////////
'// u = inité de déplacement
'// n = nombre de fois
'// e = extension de la sélection
'//////////////////////////////////////////
'/////////////////////////////////////////
'// 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
'//--------------------------------------------------------------------
'// BackSpace
'//-------------------------------------------------------------------
Sub BackSpace(n As Integer,e As Integer)
Call Selection.TypeBackspace(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(p)).Clear
End Sub
'//------------------------------------------------------------------------
'// Ajouter un signet
'//------------------------------------------------------------------------
Public Sub AddBookmark ( bookmark As String)
Call Document.Bookmarks.Add (bookmark)
End Sub
'//---------------------------------------------------------------------------
'// Remplacer le texte d'un signet
'//---------------------------------------------------------------------------
Public Sub UpdateTextBookmark (bookmark As String, value As String)
ActiveDocument.Bookmarks(bookmark).Range.Text=value
End Sub
'//---------------------------------------------------------------------------
'// Remplacer le texte d'un signet juste après
'//---------------------------------------------------------------------------
Public Sub InsertAfterBookmark (bookmark As String, value As String)
ActiveDocument.Bookmarks(bookmark).Range.InsertAfter(value)
End Sub
'//---------------------------------------------------------------------------
'// Supprimer un signet
'//---------------------------------------------------------------------------
Public Sub DeleteBookmark (bookmark As String)
ActiveDocument.Bookmarks(bookmark).Delete
End Sub
'//-----------------------------------------------------------------------
'// Selectionner un signet
'//------------------------------------------------------------------------
Sub GotoBookmark(bookmark As String)
ActiveDocument.Bookmarks(bookmark).Select
End Sub
'//-----------------------------------------------------------------------
'// Nombre de signets
'//------------------------------------------------------------------------
Function getBoorkmarks() As Integer
getBoorkmarks=ActiveDocument.Bookmarks.Count
End Function
'//-----------------------------------------------------------------------
'// Tester existance d'un signet
'//------------------------------------------------------------------------
Function ExistBookmark(bookmark As String) As Integer
ExistBookmark=ActiveDocument.Bookmarks.Exists(bookmark)
End Function
'//-----------------------------------------------------------------------
'// Affiche les signets
'//------------------------------------------------------------------------
Sub ShowBookmarks(toggle As Integer)
ActiveWindow.View.ShowBookmarks = toggle
End Sub
'//---------------------------------------------------------------------------
'// Mise à jour d'un champ
'//---------------------------------------------------------------------------
Public Sub UpdateField (field As String, value As String)
Document.FormFields(field).result = value
End Sub
'//--------------------------------------------------------------------
'// Enregistrement du document
'//-------------------------------------------------------------------
Sub saveAs(fn As String)
Activedocument.SaveAs fn
End Sub
Sub Save
ActiveDocument.Save
End Sub
'//----------------------------------------
'// Ferme le document
'//----------------------------------------
Sub CloseDocument(toogle)
Call Document.Close(toogle)
End Sub
'//--------------------------------------------------------------------
'// Appeler une macro
'//--------------------------------------------------------------------
Sub RunMacro(macro As String)
WApp.Run("[" & macro & "]")
End Sub
'//----------------------------------------
'// Entête de page
'//----------------------------------------
Sub SetHeader(t1 As String, t2 As String, t3 As String)
Dim Paragraph As Variant
Dim header As Variant
Dim p As Long
Set Section=document.Sections(1)
Set header = section.Headers(1)
Set Paragraph = header.Range
Call Paragraph.InsertBefore(t1 & Chr$(9) & t2 & Chr$(9) & t3)
Call showHeader
End Sub
'//-------------------------------------
'// Bas de page
'//------------------------------------
Sub SetFooter(t1 As String, t2 As String, t3 As String)
Dim Paragraph As Variant
Dim footer As Variant
Dim p As Long
Set Section=document.Sections(1)
Set footer = section.Footers(1)
Set Paragraph = footer.Range
Call Paragraph.InsertBefore(t1 & Chr$(9) & t2 & Chr$(9) & t3 & Chr$(9))
Set Paragraph = footer.Range
p = Paragraph.End
Call Paragraph.SetRange(p, p)
Call Paragraph.Fields.Add(Paragraph, 33)
Set Paragraph = footer.Range
p = Paragraph.End
Call Paragraph.SetRange(p, p)
Call Paragraph.InsertBefore("/")
Set Paragraph = footer.Range
p = Paragraph.End
Call Paragraph.SetRange(p, p)
Call Paragraph.Fields.Add(Paragraph, 26)
Call showHeader
End Sub
Private Sub showHeader
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
Private Sub initPanes
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
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
Public Class ExportToWord As WordSession
Sub new (template As String)
Call AddNewDocument(template)
End Sub
End Class
[/syntax]