begin process at 2008 05 12 02:34:49
1 170 118 membres
34 nouveaux aujourd'hui
13 956 membres club

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

PILOTER WORD PAR OLE AVEC ACCESS OU VB


Information sur la source

Catégorie :VBA Classé sous : ole, word, office, piloter Niveau : Expert Date de création : 01/09/2000 Date de mise à jour : 06/08/2001 00:00:00 Vu : 57 962

Note :
7,96 / 10 - par 69 personnes
7,96 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10

Commentaire sur cette source (47)
Ajouter un commentaire et/ou une note

Description

Ces routines offrent une palette assez complète des choses qu'on peut demander à Word.

Vous copiez l'intégralité de ce code et vous le collez dans un de vos modules persos réutilisables à volonté.
Si vous ne savez pas faire, vous le mettez directement dans votre application...

Vous avez un exemple concret de dialogue avec Word avec la procédure Word_test() qui se trouve à la fin de ces routines.

J'améliore ce code en permanence. N'hésitez pas à me faire vos remarques.

jprestreau@groupemalakoff.com

Source

  • '© Jacques PRESTREAU, 1999, 2000, 2001
  • 'Pour utiliser ces procédures et ces fonctions de dialogue avec Word,
  • ' il faut au préalable :
  • ' 1. Entrer dans un quelconque code Visual Basic de votre application
  • ' (celui d'un formulaire ou dans n'importe lequel de vos modules)
  • ' Si vous utilisez Access
  • ' 2. Exécuter le menu Outils/Références...
  • ' Si vous utilisez VB
  • ' 2. Exécuter le menu Projet/Références...
  • ' Que vous utilisiez Acces ou VB
  • ' 3. Dans la fenêtre qui apparaît, vérifiez que vous avez une référence sur
  • ' Microsoft Word X.y Object Library
  • ' Cochez la case si elle ne l'est pas
  • ' 4. Fermer les fenêtres avec Ok
  • ' Si vous utilisez VB
  • ' 5. Remplacez par "Dim" les mot-clés "Public" des constantes de couleur
  • ' 6. C'est tout
  • 'Une fois que c'est fait, les routines ci-dessous font partie intégrante
  • ' de votre langage Visual Basic
  • 'Vous avez un exemple de dialogue avec Word avec la procédure Word_test()
  • ' qui se trouve à la fin de ce fichier
  • ' Exécutez-le avec la touche F8 pour la démo
  • 'J'améliore ce code en permanence. N'hésitez pas à me faire vos remarques.
  • ' jprestreau@groupemalakoff.com
  • Option Explicit
  • Public Const Clr_auto As Byte = 0
  • Public Const Clr_Noir As Byte = 1
  • Public Const Clr_Bleu As Byte = 2
  • Public Const Clr_Turquoise As Byte = 3
  • Public Const Clr_VertClair As Byte = 4
  • Public Const Clr_Rose As Byte = 5
  • Public Const Clr_Rouge As Byte = 6
  • Public Const Clr_Jaune As Byte = 7
  • Public Const Clr_Blanc As Byte = 8
  • Public Const Clr_BleuFoncé As Byte = 9
  • Public Const Clr_Cyan As Byte = 10
  • Public Const Clr_Vert As Byte = 11
  • Public Const Clr_Violet As Byte = 12
  • Public Const Clr_RougeFoncé As Byte = 13
  • Public Const Clr_JauneFoncé As Byte = 14
  • Public Const Clr_GrisFoncé As Byte = 15
  • Public Const Clr_GrisClair As Byte = 16
  • Public Word_Application As Word.Application
  • Public Sub Word_A_La_Ligne(Optional Nbre_de_lignes As Variant)
  • Dim I As Byte
  • If IsMissing(Nbre_de_lignes) Then Nbre_de_lignes = 1
  • For I = 1 To Nbre_de_lignes
  • Word_Application.Selection.TypeParagraph
  • Next I
  • End Sub
  • Sub Word_Activer_Entete()
  • With Word_Application
  • If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then
  • .ActiveWindow.Panes(2).Close
  • End If
  • If .ActiveWindow.ActivePane.View.Type = wdNormalView _
  • Or .ActiveWindow.ActivePane.View.Type = wdOutlineView _
  • Or .ActiveWindow.ActivePane.View.Type = wdMasterView Then
  • .ActiveWindow.ActivePane.View.Type = wdPageView
  • End If
  • .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  • End With
  • End Sub
  • Sub Word_Activer_Corps_du_document()
  • With Word_Application
  • If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then
  • .ActiveWindow.Panes(2).Close
  • End If
  • If .ActiveWindow.ActivePane.View.Type = wdNormalView _
  • Or .ActiveWindow.ActivePane.View.Type = wdOutlineView _
  • Or .ActiveWindow.ActivePane.View.Type = wdMasterView Then
  • .ActiveWindow.ActivePane.View.Type = wdPageView
  • End If
  • .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
  • End With
  • End Sub
  • Sub Word_Activer_Pied_de_page()
  • With Word_Application
  • If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then
  • .ActiveWindow.Panes(2).Close
  • End If
  • If .ActiveWindow.ActivePane.View.Type = wdNormalView _
  • Or .ActiveWindow.ActivePane.View.Type = wdOutlineView _
  • Or .ActiveWindow.ActivePane.View.Type = wdMasterView Then
  • .ActiveWindow.ActivePane.View.Type = wdPageView
  • End If
  • .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
  • End With
  • End Sub
  • Sub Word_Aller_a_la_fin_de_la_ligne_courante()
  • Word_Application.Selection.EndKey Unit:=wdLine
  • End Sub
  • Sub Word_Aller_a_la_ligne_numéro(Optional Numéro_ligne As Variant)
  • Word_Application.Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=Numéro_ligne
  • End Sub
  • Sub Word_Aller_au_début_de_la_ligne_courante()
  • Word_Application.Selection.HomeKey Unit:=wdLine
  • End Sub
  • Public Sub Word_Atteindre_Signet(Optional Nom_signet As Variant)
  • If Not IsNull(Nom_signet) Then
  • Word_Application.Selection.GoTo What:=wdGoToBookmark, Name:=Nom_signet
  • End If
  • End Sub
  • Public Sub Word_Au_signet_Ecrire_texte(Nom_signet As String, Optional Texte As Variant)
  • Word_Atteindre_Signet (Nom_signet)
  • If Not IsNull(Texte) Then
  • Word_Ecrire_Texte (Texte)
  • End If
  • End Sub
  • Public Sub Word_Backspace()
  • Word_Application.Selection.TypeBackspace
  • End Sub
  • Public Sub Word_Bascule_Gras()
  • Word_Application.Selection.Font.Bold = wdToggle
  • End Sub
  • Public Sub Word_Bascule_Italique()
  • Word_Application.Selection.Font.Italic = wdToggle
  • End Sub
  • Function Word_Chercher_texte(Texte As Variant, Prompt_utilisateur As Boolean, Vers_le_bas As Boolean) As Boolean
  • With Word_Application
  • .Selection.Find.ClearFormatting
  • With .Selection.Find
  • .Text = Texte
  • .Replacement.Text = ""
  • .Forward = Vers_le_bas
  • .Wrap = wdFindContinue
  • .Format = False
  • .MatchCase = False
  • .MatchWholeWord = False
  • .MatchWildcards = False
  • .MatchSoundsLike = False
  • .MatchAllWordForms = False
  • If Not Prompt_utilisateur Then
  • Word_Chercher_texte = .Execute
  • End If
  • End With
  • End With
  • End Function
  • Function Word_Colonne_courante()
  • Word_Colonne_courante = Word_Application.Selection.Information(wdFirstCharacterColumnNumber)
  • End Function
  • Public Sub Word_Couleur_Texte(Couleur As Long)
  • 'Couleur peut prendre la valeur d'une des constantes Clr_xxx
  • Word_Application.Selection.Font.ColorIndex = Couleur
  • End Sub
  • Public Sub Word_Couper()
  • Word_Application.Selection.Cut
  • End Sub
  • Public Sub Word_Coller()
  • Word_Application.Selection.Paste
  • End Sub
  • Public Sub Word_Copier()
  • Word_Application.Selection.Copy
  • End Sub
  • Public Sub Word_Création_Lien_OLE()
  • On Error Resume Next ' Retarde la récupération d'erreur.
  • ' La fonction Getobject appelée sans le premier argument
  • ' renvoie une référence à une occurrence de l'application Word.
  • ' Si l'application n'est pas en exécution,
  • ' une erreur se produit et on utilise l'erreur.
  • ' Noter la virgule utilisée en tant que premier espace réservé d'argument.
  • Set Word_Application = GetObject(, "Word.Application")
  • If Err.Number <> 0 Then
  • Set Word_Application = CreateObject("Word.Application")
  • End If
  • Err.Clear ' Efface l'objet Err au cas où une erreur s'est produite.
  • End Sub
  • Public Sub Word_Début_document()
  • Word_Application.Selection.HomeKey Unit:=wdStory, Extend:=wdMove
  • End Sub
  • Public Sub Word_Delete()
  • Word_Application.Selection.Delete
  • End Sub
  • Public Sub Word_Déselectionner(Optional Curseur_a_la_fin As Boolean)
  • If Curseur_a_la_fin Then
  • Word_Application.Selection.Collapse wdCollapseEnd
  • Else
  • Word_Application.Selection.Collapse wdCollapseStart
  • End If
  • End Sub
  • Function Word_Dialogue_Imprimer() As Boolean
  • With Word_Application
  • .Visible = True
  • With Dialogs(wdDialogFilePrint)
  • If .Show = -1 Then
  • .Execute
  • End If
  • End With
  • End With
  • End Function
  • Function Word_Dialogue_Nouveau_Document() As Boolean
  • Word_Création_Lien_OLE
  • With Word_Application
  • .Visible = True
  • With Dialogs(wdDialogFileNew)
  • If .Show = -1 Then
  • .Execute
  • Word_Dialogue_Nouveau_Document = True
  • Else
  • Word_Dialogue_Nouveau_Document = False
  • End If
  • End With
  • End With
  • End Function
  • Function Word_Dialogue_Ouvrir_Document() As Boolean
  • Word_Création_Lien_OLE
  • With Word_Application
  • .Visible = True
  • With Dialogs(wdDialogFileOpen)
  • If .Show = -1 Then
  • .Execute
  • Word_Dialogue_Ouvrir_Document = True
  • Else
  • Word_Dialogue_Ouvrir_Document = False
  • End If
  • End With
  • End With
  • End Function
  • Public Sub Word_Ecrire_Paragraphe(Optional Texte As Variant, Optional Gras As Variant, Optional Italique As Variant, Optional Couleur As Variant, Optional Fonte As String, Optional Taille As Byte)
  • Word_Ecrire_Texte Texte, Gras, Italique, Couleur, Fonte, Taille
  • Word_A_La_Ligne
  • End Sub
  • Public Sub Word_Ecrire_Texte(Optional Texte As Variant, Optional Gras As Variant, Optional Italique As Variant, Optional Couleur As Variant, Optional Fonte As String, Optional Taille As Byte)
  • Dim old_Gras As Boolean
  • Dim old_Italique As Boolean
  • Dim old_Couleur As Long
  • Dim old_Fonte As String
  • Dim old_Taille As Byte
  • old_Gras = Word_Application.Selection.Font.Bold
  • If Not (IsMissing(Gras)) Then Word_Application.Selection.Font.Bold = Gras
  • old_Italique = Word_Application.Selection.Font.Italic
  • If Not (IsMissing(Italique)) Then Word_Application.Selection.Font.Italic = Italique
  • old_Couleur = Word_Application.Selection.Font.ColorIndex
  • If Not (IsMissing(Couleur)) Then Word_Application.Selection.Font.ColorIndex = Couleur
  • old_Fonte = Word_Application.Selection.Font.Name
  • If Fonte <> "" Then
  • Word_Application.Selection.Font.Name = Fonte
  • End If
  • old_Taille = Word_Application.Selection.Font.Size
  • If Taille > 0 Then
  • Word_Application.Selection.Font.Size = Taille
  • End If
  • If Not IsNull(Texte) Then
  • Word_Application.Selection.TypeText Text:=Texte
  • End If
  • Word_Application.Selection.Font.Bold = old_Gras
  • Word_Application.Selection.Font.Italic = old_Italique
  • Word_Application.Selection.Font.ColorIndex = old_Couleur
  • Word_Application.Selection.Font.Name = old_Fonte
  • Word_Application.Selection.Font.Size = old_Taille
  • End Sub
  • Public Sub Word_Enregistrer_document(Optional Nom_Document As Variant)
  • If IsNull(Nom_Document) Then
  • Word_Application.ActiveDocument.Save
  • Else
  • Word_Application.ActiveDocument.SaveAs Nom_Document
  • End If
  • End Sub
  • Public Sub Word_Enregistrer_document_sous(Optional Nom_Document As Variant)
  • If IsMissing(Nom_Document) Then
  • Dialogs(wdDialogFileSaveAs).Show
  • Else
  • Word_Application.ActiveDocument.SaveAs Nom_Document
  • End If
  • End Sub
  • Sub Word_Exécuter_Macro(Nom_Macro As String)
  • With Word_Application
  • .Run Nom_Macro
  • End With
  • End Sub
  • Public Sub Word_Fermer_Document(Optional Nom_Document As Variant)
  • Dim Doc
  • If IsMissing(Nom_Document) Then
  • Word_Application.ActiveDocument.Close
  • Else
  • For Each Doc In Word_Application.Documents
  • If Doc.Name = Nom_Document Then Doc.Close
  • Next Doc
  • End If
  • End Sub
  • Public Sub Word_Fermer_Document_sans_sauver(Optional Nom_Document As Variant)
  • Dim Doc
  • If IsMissing(Nom_Document) Then
  • Word_Application.ActiveDocument.Close savechanges:=wdDoNotSaveChanges
  • Else
  • For Each Doc In Word_Application.Windows
  • If Doc.Caption = Nom_Document Then Doc.Close savechanges:=wdDoNotSaveChanges
  • Next Doc
  • End If
  • End Sub
  • Public Sub Word_Fin_document()
  • Word_Application.Selection.EndKey Unit:=wdStory, Extend:=wdMove
  • End Sub
  • Public Sub Word_fusionner_vers_nouveau_document(Supprimer_lignes_blanches As Boolean)
  • With Word_Application.ActiveDocument.MailMerge
  • .Destination = wdSendToNewDocument
  • .SuppressBlankLines = Supprimer_lignes_blanches
  • .Execute
  • End With
  • End Sub
  • Public Sub Word_Gras(Booléen As Boolean)
  • Word_Application.Selection.Font.Bold = Booléen
  • End Sub
  • Public Sub Word_Imprimer(Optional Nom_Document As String)
  • Word_Création_Lien_OLE
  • If Nom_Document = "" Then
  • Word_Application.PrintOut _
  • FileName:="", _
  • Range:=wdPrintAllDocument, _
  • Item:=wdPrintDocumentContent, _
  • Copies:=1, _
  • PageS:="", _
  • PageType:=wdPrintAllPages, _
  • Collate:=True, _
  • Background:=False, _
  • PrintToFile:=False
  • Else
  • Word_Nouveau_document , , , , False, "Minimize", True
  • Word_Application.PrintOut _
  • FileName:=Nom_Document, _
  • Range:=wdPrintAllDocument, _
  • Item:=wdPrintDocumentContent, _
  • Copies:=1, _
  • PageS:="", _
  • PageType:=wdPrintAllPages, _
  • Collate:=True, _
  • Background:=False, _
  • PrintToFile:=False
  • Word_Application.Windows("Document d'impression").Activate
  • Word_Fermer_Document_sans_sauver
  • End If
  • End Sub
  • Public Sub Word_Imprimer_pages_impaires(Optional Nom_Document As String)
  • Word_Création_Lien_OLE
  • If Nom_Document = "" Then
  • Word_Application.PrintOut _
  • FileName:="", _
  • Range:=wdPrintAllDocument, _
  • Item:=wdPrintDocumentContent, _
  • Copies:=1, _
  • PageS:="", _
  • PageType:=wdPrintOddPagesOnly, _
  • Collate:=True, _
  • Background:=False, _
  • PrintToFile:=False
  • Else
  • Word_Nouveau_document , , , , False, "Minimize", True
  • Word_Application.PrintOut _
  • FileName:=Nom_Document, _
  • Range:=wdPrintAllDocument, _
  • Item:=wdPrintDocumentContent, _
  • Copies:=1, _
  • PageS:="", _
  • PageType:=wdPrintOddPagesOnly, _
  • Collate:=True, _
  • Background:=False, _
  • PrintToFile:=False
  • Word_Application.Windows("Document d'impression").Activate
  • Word_Fermer_Document_sans_sauver
  • End If
  • End Sub
  • Public Sub Word_Imprimer_pages_paires(Optional Nom_Document As String)
  • Word_Création_Lien_OLE
  • If Nom_Document = "" Then
  • Word_Application.PrintOut _
  • FileName:="", _
  • Range:=wdPrintAllDocument, _
  • Item:=wdPrintDocumentContent, _
  • Copies:=1, _
  • PageS:="", _
  • PageType:=wdPrintEvenPagesOnly, _
  • Collate:=True, _
  • Background:=False, _
  • PrintToFile:=False
  • Else
  • Word_Nouveau_document , , , , False, "Minimize", True
  • Word_Application.PrintOut _
  • FileName:=Nom_Document, _
  • Range:=wdPrintAllDocument, _
  • Item:=wdPrintDocumentContent, _
  • Copies:=1, _
  • PageS:="", _
  • PageType:=wdPrintEvenPagesOnly, _
  • Collate:=True, _
  • Background:=False, _
  • PrintToFile:=False
  • Word_Application.Windows("Document d'impression").Activate
  • Word_Fermer_Document_sans_sauver
  • End If
  • End Sub
  • Public Sub Word_Imprimer_recto_verso(Optional Nom_Document As String)
  • Word_Imprimer_pages_impaires
  • If MsgBox("Impression des rectos en cours..." & vbCrLf & vbCrLf & "Lorsque la dernière page sera imprimée, retournez la liasse puis cliquez sur Ok pour imprimer les versos." & vbCrLf & vbCrLf & "Sinon cliquez sur Annuler", vbInformation + vbOKCancel + vbDefaultButton1, "Impression recto-verso") = vbOK Then
  • Word_Imprimer_pages_paires
  • End If
  • End Sub
  • Public Sub Word_Insère_fichier(NomFichier As String)
  • Word_Application.Selection.InsertFile _
  • FileName:=NomFichier, _
  • Range:="", _
  • ConfirmConversions:=True, _
  • Link:=False, _
  • Attachment:=False
  • End Sub
  • Public Sub Word_Insère_Image(Nom_fichier As String, Lier_au_fichier As Boolean)
  • Word_Application.Selection.InlineShapes.AddPicture FileName:=Nom_fichier, LinkToFile:=Lier_au_fichier, SaveWithDocument:=True
  • End Sub
  • Public Sub Word_Insère_Numéros_de_pages()
  • 'Merci à Arnaud Louillet pour cette correction
  • 'NormalTemplate.AutoTextEntries("Page X sur Y").Insert Where:=Selection.Range
  • Word_Application.NormalTemplate.AutoTextEntries("Page X sur Y").Insert Where:=Word_Application.Selection.Range
  • End Sub
  • Public Sub Word_Insère_Symbole(Fonte As String, Numéro_Caractère As Long, Option_Unicode As Boolean)
  • Word_Application.Selection.InsertSymbol Font:=Fonte, CharacterNumber:=Numéro_Caractère, Unicode:=Option_Unicode
  • End Sub
  • Public Sub Word_Interligne(Taille As Byte)
  • Select Case Taille
  • Case 10
  • Word_Application.Selection.ParagraphFormat.Space1
  • Case 15
  • Word_Application.Selection.ParagraphFormat.Space15
  • End Select
  • End Sub
  • Public Sub Word_Italique(Booléen As Boolean)
  • Word_Application.Selection.Font.Italic = Booléen
  • End Sub
  • Public Sub Word_Justification(Optional Type_justification As String)
  • Select Case Type_justification
  • Case "Centré"
  • Word_Application.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
  • Case "Droite"
  • Word_Application.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
  • Case "Justifié"
  • Word_Application.Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
  • End Select
  • End Sub
  • Function Word_Ligne_courante() As Variant
  • Word_Ligne_courante = Word_Application.Selection.Information(wdFirstCharacterLineNumber)
  • End Function
  • Public Sub Word_Ligne_en_fond_de_couleur(Couleur As Variant)
  • Word_Application.Selection.ParagraphFormat.Shading.BackgroundPatternColorIndex = Couleur
  • End Sub
  • Public Sub Word_Marge_Gauche(Marge As Single)
  • Word_Application.Selection.ParagraphFormat.LeftIndent = CentimetersToPoints(Marge)
  • End Sub
  • Public Sub Word_Marge_Premiere_Ligne(Marge As Single)
  • Word_Application.Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(Marge)
  • End Sub
  • Function Word_Nom_du_document_actif() As String
  • Word_Nom_du_document_actif = Word_Application.ActiveWindow.Caption
  • End Function
  • Public Function Word_Nombre_documents_ouverts() As Byte
  • Word_Création_Lien_OLE
  • Word_Nombre_documents_ouverts = Word_Application.Documents.Count
  • End Function
  • Public Sub Word_Nouveau_document(Optional Fonte As String, Optional Taille_Caractères As Byte, Optional Justification As String, Optional Modèle As String, Optional Visible As Boolean, Optional WindowsState As String, Optional PourImpression As Boolean)
  • Word_Création_Lien_OLE
  • With Word_Application
  • If Modèle = "" Then
  • .Documents.Add
  • Else
  • .Documents.Add Modèle
  • End If
  • If PourImpression Then
  • .ActiveWindow.Caption = "Document d'impression"
  • End If
  • Word_Taille_fenetre WindowsState
  • .Visible = Visible
  • End With
  • Word_Justification Justification
  • Word_Police_de_caracteres Fonte
  • Word_Taille_Caractères Taille_Caractères
  • End Sub
  • Public Sub Word_Ouvrir_document(Nom_Document As Variant, Visible As Boolean)
  • Word_Création_Lien_OLE
  • With Word_Application
  • .Visible = Visible
  • .Documents.Open _
  • FileName:=Nom_Document, _
  • ConfirmConversions:=True, _
  • ReadOnly:=False, _
  • AddToRecentFiles:=False, _
  • PasswordDocument:="", _
  • PasswordTemplate:="", _
  • Revert:=False, _
  • WritePasswordDocument:="", _
  • WritePasswordTemplate:="", _
  • Format:=wdOpenFormatAuto
  • End With
  • End Sub
  • Public Sub Word_Police_de_caracteres(Optional Fonte As String)
  • If Fonte <> "" Then
  • Word_Application.Selection.Font.Name = Fonte
  • End If
  • End Sub
  • Public Sub Word_Renommer_fenetre_active(Nom_fenetre As String)
  • Word_Application.ActiveWindow.Caption = Nom_fenetre
  • End Sub
  • Public Sub Word_Quitter()
  • ' Si cette copie de Microsoft Word n'était pas déjà en exécution
  • ' lorsque vous l'avez utilisée,
  • ' elle est fermée à l'aide de la méthode Quit de la propriété Application
  • ' puis le lien est rompu
  • ' sinon l'application et le lien sont conservés.
  • ' Notez que si vous tentez de quitter Microsoft Word,
  • ' la barre de titre Microsoft Word clignote et
  • ' Microsoft Word affiche un message vous demandant si
  • ' vous souhaitez enregistrer les fichiers chargés.
  • If Word_Nombre_documents_ouverts = 0 Then
  • Word_Application.Quit
  • End If
  • End Sub
  • Sub Word_Remplacer_texte(Texte_à_remplacer As Variant, Texte_de_remplacement As Variant, Tout As Boolean)
  • With Word_Application
  • .Selection.Find.ClearFormatting
  • .Selection.Find.Replacement.ClearFormatting
  • With .Selection.Find
  • .Text = Texte_à_remplacer
  • .Replacement.Text = Texte_de_remplacement
  • .Forward = True
  • .Wrap = wdFindContinue
  • .Format = False
  • .MatchCase = False
  • .MatchWholeWord = False
  • .MatchWildcards = False
  • .MatchSoundsLike = False
  • .MatchAllWordForms = False
  • End With
  • .Selection.Find.Execute
  • With .Selection
  • If .Find.Forward = True Then
  • .Collapse Direction:=wdCollapseStart
  • Else
  • .Collapse Direction:=wdCollapseEnd
  • End If
  • If Tout Then
  • .Find.Execute replace:=wdReplaceAll
  • Else
  • .Find.Execute replace:=wdReplaceOne
  • End If
  • End With
  • End With
  • End Sub
  • Public Sub Word_Saut_de_page()
  • Word_Application.Selection.InsertBreak Type:=wdPageBreak
  • End Sub
  • Public Sub Word_Sélectionner_lignes(Optional Nbre_de_lignes As Variant)
  • If IsMissing(Nbre_de_lignes) Then Nbre_de_lignes = 1
  • Word_Application.Selection.MoveDown Unit:=wdLine, Count:=Nbre_de_lignes, Extend:=wdExtend
  • End Sub
  • Public Sub Word_Sélectionner_paragraphe(Numéro_paragraphe As Long)
  • Word_Application.ActiveDocument.Paragraphs(Numéro_paragraphe).Range.Select
  • End Sub
  • Public Sub Word_Suppression_Lien_OLE()
  • Set Word_Application = Nothing
  • End Sub
  • Public Sub Word_Tabulation_Ajout(Alignement As String, En_Position As Variant)
  • Select Case Alignement
  • Case "Centré"
  • Word_Application.Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(En_Position), Alignment:=wdAlignTabCenter, Leader:=wdTabLeaderSpaces
  • Case "Décimal"
  • Word_Application.Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(En_Position), Alignment:=wdAlignTabDecimal, Leader:=wdTabLeaderSpaces
  • Case "Droit"
  • Word_Application.Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(En_Position), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
  • Case "Gauche"
  • Word_Application.Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(En_Position), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
  • End Select
  • End Sub
  • Public Sub Word_Tabulation_Suppression(En_Position As Variant)
  • Word_Application.Selection.ParagraphFormat.TabStops(CentimetersToPoints(En_Position)).Clear
  • End Sub
  • Public Sub Word_Taille_Caractères(Optional Taille As Byte)
  • If Taille > 0 Then
  • Word_Application.Selection.Font.Size = Taille
  • End If
  • End Sub
  • Public Sub Word_Taille_fenetre(Optional WindowsState As String)
  • With Word_Application
  • Select Case WindowsState
  • Case "Maximize"
  • .ActiveWindow.WindowState = wdWindowStateMaximize
  • Case "Minimize"
  • .ActiveWindow.WindowState = wdWindowStateMinimize
  • Case "Normal"
  • .ActiveWindow.WindowState = wdWindowStateNormal
  • End Select
  • End With
  • End Sub
  • Function Word_Texte_trouvé(Texte As Variant, Prompt_utilisateur As Boolean, Vers_le_bas As Boolean) As Boolean
  • Word_Texte_trouvé = Word_Chercher_texte(Texte, Prompt_utilisateur, Vers_le_bas)
  • End Function
  • Public Sub Word_Vers_la_droite(Optional Nbre_de_caractères As Variant)
  • If IsMissing(Nbre_de_caractères) Then Nbre_de_caractères = 1
  • Word_Application.Selection.MoveRight Unit:=wdCharacter, Count:=Nbre_de_caractères
  • End Sub
  • Public Sub Word_Vers_la_gauche(Optional Nbre_de_caractères As Variant)
  • If IsMissing(Nbre_de_caractères) Then Nbre_de_caractères = 1
  • Word_Application.Selection.MoveLeft Unit:=wdCharacter, Count:=Nbre_de_caractères
  • End Sub
  • Public Sub Word_Vers_le_bas(Optional Nbre_de_lignes As Variant)
  • If IsMissing(Nbre_de_lignes) Then Nbre_de_lignes = 1
  • Word_Application.Selection.MoveDown Unit:=wdLine, Count:=Nbre_de_lignes
  • End Sub
  • Public Sub Word_Vers_le_haut(Optional Nbre_de_lignes As Variant)
  • If IsMissing(Nbre_de_lignes) Then Nbre_de_lignes = 1
  • Word_Application.Selection.MoveUp Unit:=wdLine, Count:=Nbre_de_lignes
  • End Sub
  • Sub Word_test()
  • Word_Nouveau_document "Arial", 12, "Justifié", , True
  • Word_Insère_Symbole "Wingdings", -3979, True
  • Word_Ecrire_Texte "Hello !"
  • Word_A_La_Ligne 2
  • Word_Ecrire_Paragraphe "Tout cela"
  • Word_Ecrire_Paragraphe "s'exécutera"
  • Word_Ecrire_Texte "automatiquement ", True, True, 2, "Times new roman", 20
  • Word_Ecrire_Paragraphe "dans Word"
  • Word_Ecrire_Paragraphe "directement", True, True, 5, "Courrier", 16
  • Word_Début_document
  • Word_Chercher_texte "Tout cela", False, True
  • Word_Déselectionner True
  • Word_Ecrire_Texte " "
  • Word_Delete
  • Word_Remplacer_texte "ra", "", False
  • Word_Déselectionner True
  • Word_Ecrire_Texte " "
  • Word_Delete
  • Word_Chercher_texte "dans Word", False, True
  • Word_Déselectionner True
  • Word_Ecrire_Texte " "
  • Word_Delete
  • Word_Chercher_texte "directement", False, True
  • Word_Déselectionner True
  • Word_Ecrire_Texte " !"
  • Word_Début_document
  • Word_Remplacer_texte "dans Word", "depuis Access", False
  • Word_Fin_document
  • Word_A_La_Ligne 2
  • Word_Tabulation_Ajout "Droit", 12
  • Word_Ecrire_Texte vbTab & "Jacques"
  • Word_Début_document
  • Word_Chercher_texte "directement", False, True
  • Word_Couper
  • Word_Début_document
  • Word_Chercher_texte "depuis", False, True
  • Word_Déselectionner
  • Word_Coller
  • Word_Début_document
  • Word_Activer_Pied_de_page
  • Word_Ecrire_Texte Format(Date, "dddd dd mm yyyy")
  • Word_Insère_Numéros_de_pages
  • Word_Activer_Entete
  • Word_Justification "Centré"
  • Word_Ecrire_Texte "Démo"
  • Word_Activer_Corps_du_document
  • End Sub
'© Jacques PRESTREAU, 1999, 2000, 2001

'Pour utiliser ces procédures et ces fonctions de dialogue avec Word,
'  il faut au préalable :

'  1. Entrer dans un quelconque code Visual Basic de votre application
'     (celui d'un formulaire ou dans n'importe lequel de vos modules)

'  Si vous utilisez Access
'  2. Exécuter le menu Outils/Références...

'  Si vous utilisez VB
'  2. Exécuter le menu Projet/Références...

'  Que vous utilisiez Acces ou VB
'  3. Dans la fenêtre qui apparaît, vérifiez que vous avez une référence sur
'     Microsoft Word X.y Object Library
'     Cochez la case si elle ne l'est pas
'  4. Fermer les fenêtres avec Ok

'  Si vous utilisez VB
'  5. Remplacez par "Dim" les mot-clés "Public" des constantes de couleur
'  6. C'est tout

'Une fois que c'est fait, les routines ci-dessous font partie intégrante
'  de votre langage Visual Basic

'Vous avez un exemple de dialogue avec Word avec la procédure Word_test()
'  qui se trouve à la fin de ce fichier
'  Exécutez-le avec la touche F8 pour la démo

'J'améliore ce code en permanence. N'hésitez pas à me faire vos remarques.

'  jprestreau@groupemalakoff.com

Option Explicit

Public Const Clr_auto       As Byte = 0
Public Const Clr_Noir       As Byte = 1
Public Const Clr_Bleu       As Byte = 2
Public Const Clr_Turquoise  As Byte = 3
Public Const Clr_VertClair  As Byte = 4
Public Const Clr_Rose       As Byte = 5
Public Const Clr_Rouge      As Byte = 6
Public Const Clr_Jaune      As Byte = 7
Public Const Clr_Blanc      As Byte = 8
Public Const Clr_BleuFoncé  As Byte = 9
Public Const Clr_Cyan       As Byte = 10
Public Const Clr_Vert       As Byte = 11
Public Const Clr_Violet     As Byte = 12
Public Const Clr_RougeFoncé As Byte = 13
Public Const Clr_JauneFoncé As Byte = 14
Public Const Clr_GrisFoncé  As Byte = 15
Public Const Clr_GrisClair  As Byte = 16

Public Word_Application As Word.Application

Public Sub Word_A_La_Ligne(Optional Nbre_de_lignes As Variant)

Dim I As Byte

If IsMissing(Nbre_de_lignes) Then Nbre_de_lignes = 1

For I = 1 To Nbre_de_lignes
   Word_Application.Selection.TypeParagraph
Next I

End Sub

Sub Word_Activer_Entete()
    
With Word_Application
   If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then
      .ActiveWindow.Panes(2).Close
   End If
   If .ActiveWindow.ActivePane.View.Type = wdNormalView _
   Or .ActiveWindow.ActivePane.View.Type = wdOutlineView _
   Or .ActiveWindow.ActivePane.View.Type = wdMasterView Then
      .ActiveWindow.ActivePane.View.Type = wdPageView
   End If
   .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End With

End Sub

Sub Word_Activer_Corps_du_document()

With Word_Application
   If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then
      .ActiveWindow.Panes(2).Close
   End If
   If .ActiveWindow.ActivePane.View.Type = wdNormalView _
   Or .ActiveWindow.ActivePane.View.Type = wdOutlineView _
   Or .ActiveWindow.ActivePane.View.Type = wdMasterView Then
      .ActiveWindow.ActivePane.View.Type = wdPageView
   End If
   .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End With

End Sub

Sub Word_Activer_Pied_de_page()

With Word_Application
   If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then
      .ActiveWindow.Panes(2).Close
   End If
   If .ActiveWindow.ActivePane.View.Type = wdNormalView _
   Or .ActiveWindow.ActivePane.View.Type = wdOutlineView _
   Or .ActiveWindow.ActivePane.View.Type = wdMasterView Then
      .ActiveWindow.ActivePane.View.Type = wdPageView
   End If
   .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
End With

End Sub

Sub Word_Aller_a_la_fin_de_la_ligne_courante()

Word_Application.Selection.EndKey Unit:=wdLine

End Sub

Sub Word_Aller_a_la_ligne_numéro(Optional Numéro_ligne As Variant)

Word_Application.Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=Numéro_ligne

End Sub

Sub Word_Aller_au_début_de_la_ligne_courante()

Word_Application.Selection.HomeKey Unit:=wdLine

End Sub

Public Sub Word_Atteindre_Signet(Optional Nom_signet As Variant)

If Not IsNull(Nom_signet) Then
   Word_Application.Selection.GoTo What:=wdGoToBookmark, Name:=Nom_signet
End If

End Sub

Public Sub Word_Au_signet_Ecrire_texte(Nom_signet As String, Optional Texte As Variant)

Word_Atteindre_Signet (Nom_signet)

If Not IsNull(Texte) Then
   Word_Ecrire_Texte (Texte)
End If

End Sub

Public Sub Word_Backspace()

Word_Application.Selection.TypeBackspace

End Sub

Public Sub Word_Bascule_Gras()

Word_Application.Selection.Font.Bold = wdToggle

End Sub

Public Sub Word_Bascule_Italique()

Word_Application.Selection.Font.Italic = wdToggle

End Sub

Function Word_Chercher_texte(Texte As Variant, Prompt_utilisateur As Boolean, Vers_le_bas As Boolean) As Boolean

With Word_Application
   .Selection.Find.ClearFormatting
   With .Selection.Find
       .Text = Texte
       .Replacement.Text = ""
       .Forward = Vers_le_bas
       .Wrap = wdFindContinue
       .Format = False
       .MatchCase = False
       .MatchWholeWord = False
       .MatchWildcards = False
       .MatchSoundsLike = False
       .MatchAllWordForms = False
       If Not Prompt_utilisateur Then
           Word_Chercher_texte = .Execute
       End If
   End With
End With

End Function

Function Word_Colonne_courante()

Word_Colonne_courante = Word_Application.Selection.Information(wdFirstCharacterColumnNumber)

End Function

Public Sub Word_Couleur_Texte(Couleur As Long)

'Couleur peut prendre la valeur d'une des constantes Clr_xxx

Word_Application.Selection.Font.ColorIndex = Couleur

End Sub

Public Sub Word_Couper()

Word_Application.Selection.Cut

End Sub

Public Sub Word_Coller()

Word_Application.Selection.Paste

End Sub

Public Sub Word_Copier()

Word_Application.Selection.Copy

End Sub

Public Sub Word_Création_Lien_OLE()

On Error Resume Next ' Retarde la récupération d'erreur.

' La fonction Getobject appelée sans le premier argument
'  renvoie une référence à une occurrence de l'application Word.
'  Si l'application n'est pas en exécution,
'     une erreur se produit et on utilise l'erreur.
'  Noter la virgule utilisée en tant que premier espace réservé d'argument.

Set Word_Application = GetObject(, "Word.Application")

If Err.Number <> 0 Then
   Set Word_Application = CreateObject("Word.Application")
End If

Err.Clear   ' Efface l'objet Err au cas où une erreur s'est produite.

End Sub

Public Sub Word_Début_document()

Word_Application.Selection.HomeKey Unit:=wdStory, Extend:=wdMove

End Sub

Public Sub Word_Delete()

Word_Application.Selection.Delete

End Sub

Public Sub Word_Déselectionner(Optional Curseur_a_la_fin As Boolean)

If Curseur_a_la_fin Then
   Word_Application.Selection.Collapse wdCollapseEnd
Else
   Word_Application.Selection.Collapse wdCollapseStart
End If

End Sub

Function Word_Dialogue_Imprimer() As Boolean

With Word_Application
   .Visible = True
   With Dialogs(wdDialogFilePrint)
      If .Show = -1 Then
         .Execute
      End If
   End With
End With

End Function

Function Word_Dialogue_Nouveau_Document() As Boolean

Word_Création_Lien_OLE

With Word_Application
   .Visible = True
   With Dialogs(wdDialogFileNew)
      If .Show = -1 Then
         .Execute
         Word_Dialogue_Nouveau_Document = True
      Else
         Word_Dialogue_Nouveau_Document = False
      End If
   End With
End With

End Function

Function Word_Dialogue_Ouvrir_Document() As Boolean

Word_Création_Lien_OLE

With Word_Application
   .Visible = True
   With Dialogs(wdDialogFileOpen)
      If .Show = -1 Then
         .Execute
         Word_Dialogue_Ouvrir_Document = True
      Else
         Word_Dialogue_Ouvrir_Document = False
      End If
   End With
End With

End Function

Public Sub Word_Ecrire_Paragraphe(Optional Texte As Variant, Optional Gras As Variant, Optional Italique As Variant, Optional Couleur As Variant, Optional Fonte As String, Optional Taille As Byte)

Word_Ecrire_Texte Texte, Gras, Italique, Couleur, Fonte, Taille
Word_A_La_Ligne

End Sub

Public Sub Word_Ecrire_Texte(Optional Texte As Variant, Optional Gras As Variant, Optional Italique As Variant, Optional Couleur As Variant, Optional Fonte As String, Optional Taille As Byte)

Dim old_Gras As Boolean
Dim old_Italique As Boolean
Dim old_Couleur As Long
Dim old_Fonte As String
Dim old_Taille As Byte

old_Gras = Word_Application.Selection.Font.Bold
If Not (IsMissing(Gras)) Then Word_Application.Selection.Font.Bold = Gras

old_Italique = Word_Application.Selection.Font.Italic
If Not (IsMissing(Italique)) Then Word_Application.Selection.Font.Italic = Italique

old_Couleur = Word_Application.Selection.Font.ColorIndex
If Not (IsMissing(Couleur)) Then Word_Application.Selection.Font.ColorIndex = Couleur

old_Fonte = Word_Application.Selection.Font.Name
If Fonte <> "" Then
   Word_Application.Selection.Font.Name = Fonte
End If

old_Taille = Word_Application.Selection.Font.Size
If Taille > 0 Then
   Word_Application.Selection.Font.Size = Taille
End If

If Not IsNull(Texte) Then
   Word_Application.Selection.TypeText Text:=Texte
End If

Word_Application.Selection.Font.Bold = old_Gras
Word_Application.Selection.Font.Italic = old_Italique
Word_Application.Selection.Font.ColorIndex = old_Couleur
Word_Application.Selection.Font.Name = old_Fonte
Word_Application.Selection.Font.Size = old_Taille

End Sub

Public Sub Word_Enregistrer_document(Optional Nom_Document As Variant)

If IsNull(Nom_Document) Then
   Word_Application.ActiveDocument.Save
Else
   Word_Application.ActiveDocument.SaveAs Nom_Document
End If

End Sub

Public Sub Word_Enregistrer_document_sous(Optional Nom_Document As Variant)

If IsMissing(Nom_Document) Then
   Dialogs(wdDialogFileSaveAs).Show
Else
   Word_Application.ActiveDocument.SaveAs Nom_Document
End If

End Sub

Sub Word_Exécuter_Macro(Nom_Macro As String)

With Word_Application
   .Run Nom_Macro
End With

End Sub

Public Sub Word_Fermer_Document(Optional Nom_Document As Variant)

Dim Doc

If IsMissing(Nom_Document) Then
   Word_Application.ActiveDocument.Close
Else
   For Each Doc In Word_Application.Documents
      If Doc.Name = Nom_Document Then Doc.Close
   Next Doc
End If

End Sub

Public Sub Word_Fermer_Document_sans_sauver(Optional Nom_Document As Variant)

Dim Doc

If IsMissing(Nom_Document) Then
   Word_Application.ActiveDocument.Close savechanges:=wdDoNotSaveChanges
Else
   For Each Doc In Word_Application.Windows
      If Doc.Caption = Nom_Document Then Doc.Close savechanges:=wdDoNotSaveChanges
   Next Doc
End If


End Sub

Public Sub Word_Fin_document()

Word_Application.Selection.EndKey Unit:=wdStory, Extend:=wdMove

End Sub

Public Sub Word_fusionner_vers_nouveau_document(Supprimer_lignes_blanches As Boolean)
 
With Word_Application.ActiveDocument.MailMerge
   .Destination = wdSendToNewDocument
   .SuppressBlankLines = Supprimer_lignes_blanches
   .Execute
End With
 
End Sub


Public Sub Word_Gras(Booléen As Boolean)

Word_Application.Selection.Font.Bold = Booléen

End Sub

Public Sub Word_Imprimer(Optional Nom_Document As String)

Word_Création_Lien_OLE

If Nom_Document = "" Then
   Word_Application.PrintOut _
                        FileName:="", _
                        Range:=wdPrintAllDocument, _
                        Item:=wdPrintDocumentContent, _
                        Copies:=1, _
                        PageS:="", _
                        PageType:=wdPrintAllPages, _
                        Collate:=True, _
                        Background:=False, _
                        PrintToFile:=False
Else
   Word_Nouveau_document , , , , False, "Minimize", True
   Word_Application.PrintOut _
                        FileName:=Nom_Document, _
                        Range:=wdPrintAllDocument, _
                        Item:=wdPrintDocumentContent, _
                        Copies:=1, _
                        PageS:="", _
                        PageType:=wdPrintAllPages, _
                        Collate:=True, _
                        Background:=False, _
                        PrintToFile:=False
   Word_Application.Windows("Document d'impression").Activate
   Word_Fermer_Document_sans_sauver
End If

End Sub

Public Sub Word_Imprimer_pages_impaires(Optional Nom_Document As String)

Word_Création_Lien_OLE

If Nom_Document = "" Then
   Word_Application.PrintOut _
                        FileName:="", _
                        Range:=wdPrintAllDocument, _
                        Item:=wdPrintDocumentContent, _
                        Copies:=1, _
                        PageS:="", _
                        PageType:=wdPrintOddPagesOnly, _
                        Collate:=True, _
                        Background:=False, _
                        PrintToFile:=False
Else
   Word_Nouveau_document , , , , False, "Minimize", True
   Word_Application.PrintOut _
                        FileName:=Nom_Document, _
                        Range:=wdPrintAllDocument, _
                        Item:=wdPrintDocumentContent, _
                        Copies:=1, _
                        PageS:="", _
                        PageType:=wdPrintOddPagesOnly, _
                        Collate:=True, _
                        Background:=False, _
                        PrintToFile:=False
   Word_Application.Windows("Document d'impression").Activate
   Word_Fermer_Document_sans_sauver
End If

End Sub

Public Sub Word_Imprimer_pages_paires(Optional Nom_Document As String)

Word_Création_Lien_OLE

If Nom_Document = "" Then
   Word_Application.PrintOut _
                        FileName:="", _
                        Range:=wdPrintAllDocument, _
                        Item:=wdPrintDocumentContent, _
                        Copies:=1, _
                        PageS:="", _
                        PageType:=wdPrintEvenPagesOnly, _
                        Collate:=True, _
                        Background:=False, _
                        PrintToFile:=False
Else
   Word_Nouveau_document , , , , False, "Minimize", True
   Word_Application.PrintOut _
                        FileName:=Nom_Document, _
                        Range:=wdPrintAllDocument, _
                        Item:=wdPrintDocumentContent, _
                        Copies:=1, _
                        PageS:="", _
                        PageType:=wdPrintEvenPagesOnly, _
                        Collate:=True, _
                        Background:=False, _
                        PrintToFile:=False
   Word_Application.Windows("Document d'impression").Activate
   Word_Fermer_Document_sans_sauver
End If

End Sub

Public Sub Word_Imprimer_recto_verso(Optional Nom_Document As String)

Word_Imprimer_pages_impaires

If MsgBox("Impression des rectos en cours..." & vbCrLf & vbCrLf & "Lorsque la dernière page sera imprimée, retournez la liasse puis cliquez sur Ok pour imprimer les versos." & vbCrLf & vbCrLf & "Sinon cliquez sur Annuler", vbInformation + vbOKCancel + vbDefaultButton1, "Impression recto-verso") = vbOK Then
   Word_Imprimer_pages_paires
End If

End Sub

Public Sub Word_Insère_fichier(NomFichier As String)

Word_Application.Selection.InsertFile _
                        FileName:=NomFichier, _
                        Range:="", _
                        ConfirmConversions:=True, _
                        Link:=False, _
                        Attachment:=False

End Sub

Public Sub Word_Insère_Image(Nom_fichier As String, Lier_au_fichier As Boolean)
    
Word_Application.Selection.InlineShapes.AddPicture FileName:=Nom_fichier, LinkToFile:=Lier_au_fichier, SaveWithDocument:=True

End Sub

Public Sub Word_Insère_Numéros_de_pages()

'Merci à Arnaud Louillet pour cette correction
'NormalTemplate.AutoTextEntries("Page X sur Y").Insert Where:=Selection.Range
Word_Application.NormalTemplate.AutoTextEntries("Page X sur Y").Insert Where:=Word_Application.Selection.Range

End Sub

Public Sub Word_Insère_Symbole(Fonte As String, Numéro_Caractère As Long, Option_Unicode As Boolean)

Word_Application.Selection.InsertSymbol Font:=Fonte, CharacterNumber:=Numéro_Caractère, Unicode:=Option_Unicode

End Sub

Public Sub Word_Interligne(Taille As Byte)

Select Case Taille
   Case 10
      Word_Application.Selection.ParagraphFormat.Space1
   Case 15
      Word_Application.Selection.ParagraphFormat.Space15
End Select

End Sub

Public Sub Word_Italique(Booléen As Boolean)

Word_Application.Selection.Font.Italic = Booléen

End Sub

Public Sub Word_Justification(Optional Type_justification As String)

Select Case Type_justification
   Case "Centré"
      Word_Application.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
   Case "Droite"
      Word_Application.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
   Case "Justifié"
      Word_Application.Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
End Select

End Sub

Function Word_Ligne_courante() As Variant

Word_Ligne_courante = Word_Application.Selection.Information(wdFirstCharacterLineNumber)

End Function

Public Sub Word_Ligne_en_fond_de_couleur(Couleur As Variant)

Word_Application.Selection.ParagraphFormat.Shading.BackgroundPatternColorIndex = Couleur

End Sub

Public Sub Word_Marge_Gauche(Marge As Single)

Word_Application.Selection.ParagraphFormat.LeftIndent = CentimetersToPoints(Marge)

End Sub

Public Sub Word_Marge_Premiere_Ligne(Marge As Single)

Word_Application.Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(Marge)

End Sub

Function Word_Nom_du_document_actif() As String

Word_Nom_du_document_actif = Word_Application.ActiveWindow.Caption

End Function

Public Function Word_Nombre_documents_ouverts() As Byte

Word_Création_Lien_OLE
Word_Nombre_documents_ouverts = Word_Application.Documents.Count

End Function

Public Sub Word_Nouveau_document(Optional Fonte As String, Optional Taille_Caractères As Byte, Optional Justification As String, Optional Modèle As String, Optional Visible As Boolean, Optional WindowsState As String, Optional PourImpression As Boolean)

Word_Création_Lien_OLE

With Word_Application
   If Modèle = "" Then
      .Documents.Add
   Else
      .Documents.Add Modèle
   End If
   
   If PourImpression Then
      .ActiveWindow.Caption = "Document d'impression"
   End If
   
   Word_Taille_fenetre WindowsState
   
   .Visible = Visible

End With
   
Word_Justification Justification
Word_Police_de_caracteres Fonte
Word_Taille_Caractères Taille_Caractères

End Sub

Public Sub Word_Ouvrir_document(Nom_Document As Variant, Visible As Boolean)

Word_Création_Lien_OLE

With Word_Application
   .Visible = Visible
   .Documents.Open _
                  FileName:=Nom_Document, _
                  ConfirmConversions:=True, _
                  ReadOnly:=False, _
                  AddToRecentFiles:=False, _
                  PasswordDocument:="", _
                  PasswordTemplate:="", _
                  Revert:=False, _
                  WritePasswordDocument:="", _
                  WritePasswordTemplate:="", _
                  Format:=wdOpenFormatAuto
End With

End Sub

Public Sub Word_Police_de_caracteres(Optional Fonte As String)

If Fonte <> "" Then
   Word_Application.Selection.Font.Name = Fonte
End If

End Sub

Public Sub Word_Renommer_fenetre_active(Nom_fenetre As String)

Word_Application.ActiveWindow.Caption = Nom_fenetre

End Sub

Public Sub Word_Quitter()

' Si cette copie de Microsoft Word n'était pas déjà en exécution
'  lorsque vous l'avez utilisée,
'  elle est fermée à l'aide de la méthode Quit de la propriété Application
'  puis le lien est rompu
'  sinon l'application et le lien sont conservés.
' Notez que si vous tentez de quitter Microsoft Word,
'  la barre de titre Microsoft Word clignote et
'  Microsoft Word affiche un message vous demandant si
'  vous souhaitez enregistrer les fichiers chargés.

If Word_Nombre_documents_ouverts = 0 Then
   Word_Application.Quit
End If

End Sub

Sub Word_Remplacer_texte(Texte_à_remplacer As Variant, Texte_de_remplacement As Variant, Tout As Boolean)

With Word_Application
    .Selection.Find.ClearFormatting
    .Selection.Find.Replacement.ClearFormatting
    With .Selection.Find
        .Text = Texte_à_remplacer
        .Replacement.Text = Texte_de_remplacement
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    .Selection.Find.Execute
    With .Selection
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        If Tout Then
            .Find.Execute replace:=wdReplaceAll
        Else
            .Find.Execute replace:=wdReplaceOne
        End If
    End With
End With

End Sub

Public Sub Word_Saut_de_page()

Word_Application.Selection.InsertBreak Type:=wdPageBreak

End Sub

Public Sub Word_Sélectionner_lignes(Optional Nbre_de_lignes As Variant)

If IsMissing(Nbre_de_lignes) Then Nbre_de_lignes = 1

Word_Application.Selection.MoveDown Unit:=wdLine, Count:=Nbre_de_lignes, Extend:=wdExtend

End Sub

Public Sub Word_Sélectionner_paragraphe(Numéro_paragraphe As Long)

Word_Application.ActiveDocument.Paragraphs(Numéro_paragraphe).Range.Select

End Sub

Public Sub Word_Suppression_Lien_OLE()

Set Word_Application = Nothing

End Sub

Public Sub Word_Tabulation_Ajout(Alignement As String, En_Position As Variant)

Select Case Alignement
   Case "Centré"
      Word_Application.Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(En_Position), Alignment:=wdAlignTabCenter, Leader:=wdTabLeaderSpaces
   Case "Décimal"
      Word_Application.Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(En_Position), Alignment:=wdAlignTabDecimal, Leader:=wdTabLeaderSpaces
   Case "Droit"
      Word_Application.Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(En_Position), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
   Case "Gauche"
      Word_Application.Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(En_Position), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
End Select

End Sub

Public Sub Word_Tabulation_Suppression(En_Position As Variant)

Word_Application.Selection.ParagraphFormat.TabStops(CentimetersToPoints(En_Position)).Clear

End Sub

Public Sub Word_Taille_Caractères(Optional Taille As Byte)

If Taille > 0 Then
   Word_Application.Selection.Font.Size = Taille
End If

End Sub

Public Sub Word_Taille_fenetre(Optional WindowsState As String)

With Word_Application
   Select Case WindowsState
      Case "Maximize"
         .ActiveWindow.WindowState = wdWindowStateMaximize
      Case "Minimize"
         .ActiveWindow.WindowState = wdWindowStateMinimize
      Case "Normal"
         .ActiveWindow.WindowState = wdWindowStateNormal
   End Select
End With

End Sub

Function Word_Texte_trouvé(Texte As Variant, Prompt_utilisateur As Boolean, Vers_le_bas As Boolean) As Boolean

Word_Texte_trouvé = Word_Chercher_texte(Texte, Prompt_utilisateur, Vers_le_bas)

End Function

Public Sub Word_Vers_la_droite(Optional Nbre_de_caractères As Variant)

If IsMissing(Nbre_de_caractères) Then Nbre_de_caractères = 1

Word_Application.Selection.MoveRight Unit:=wdCharacter, Count:=Nbre_de_caractères

End Sub

Public Sub Word_Vers_la_gauche(Optional Nbre_de_caractères As Variant)

If IsMissing(Nbre_de_caractères) Then Nbre_de_caractères = 1

Word_Application.Selection.MoveLeft Unit:=wdCharacter, Count:=Nbre_de_caractères

End Sub

Public Sub Word_Vers_le_bas(Optional Nbre_de_lignes As Variant)

If IsMissing(Nbre_de_lignes) Then Nbre_de_lignes = 1

Word_Application.Selection.MoveDown Unit:=wdL