|
begin process at 2008 05 12 02:34:49
Derniers logiciels
|
Trouver une ressource
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
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 |
|