Piloter word par ole avec access ou vb

Soyez le premier à donner votre avis sur cette source.

Snippet vu 85 294 fois - Téléchargée 69 fois

Commenter

Contenu du snippet

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 / Exemple : 


'© 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

Conclusion :


Faites un test en mode pas à pas (F8) avec la procédure Word_test.

Vous m'en direz des nouvelles !

A voir également

Ajouter un commentaire

Commentaires

Signaler
fredpro59
Messages postés
9
Date d'inscription
mardi 1 septembre 2009
Statut
Membre
Dernière intervention
22 juillet 2010
Bonjour,

Très bien ce code ! Je l'ai enrichi avec la possibilité de créer une instance de document Word, donc ouvrir un modèle (.dot) sans risque d'écraser le fichier d'origine.

Public Sub Word_Instance_document(Nom_Document As Variant, Visible As Boolean)
Word_Création_Lien_OLE
With Word_Application
.Visible = Visible
.WindowState = wdWindowStateMaximize
.Documents.Add Template:=Nom_Document
End With
End Sub

Bonne utilisation
Signaler
johan3240
Messages postés
10
Date d'inscription
vendredi 6 mai 2005
Statut
Membre
Dernière intervention
6 juillet 2009
Bonjour,

Je voudrais le code source pour pouvoir créer, à partir de VBA Excel (d'une feuille ou d 'une macro peu importe), un tableau vierge, dans un document word, sans devoir parcourir un range ou des cellules d'un tableau excel.
Je veux qu'il soit vierge et pouvoir y mettre des variables d'une bdd access par la suite.

Donc pour faire simple, je veux pouvoir créer un tableau en lui définissant un nombre de colonnes et u nnombre de cellules sans devoir parcourir le tableur Excel!!!!!

Merci,
Signaler
cs_asimengo
Messages postés
281
Date d'inscription
jeudi 24 mars 2005
Statut
Membre
Dernière intervention
18 mars 2009
voila j'ai uploader ma source sur le pilotage de word http://www.vbfrance.com/code.aspx?ID=44998
Signaler
cs_asimengo
Messages postés
281
Date d'inscription
jeudi 24 mars 2005
Statut
Membre
Dernière intervention
18 mars 2009
Je viens de faire une étude plus approfondie sur le sujet, pour mon idée d'utiliser word pour créer des états c impec avec impresion, visualisation, sauvegarde état depuis VB, au fait il suffit de faire les bonne declarations dim oDoc as Word.Document et chaque fois il sera facile de trouver les propriétés et méthodes qu'il faut avec la suggestion de VB.

il en ressort que ce code est peut-etre bien mais a quelque limite, il intereagit avec la version de word ouverte. Il faut plutot faire une classe et ouvrir sa propre session word, genre
Dim oWord As Word.Application
set oWord = new Word.Application
set oDoc=oWord.open(...)
le reste c rien que la POO, un peu d'aide sur la hiérarchie des objets et t'as pas forcement besoin à l'avance pour les propriétés et les méthodes les libellés parlent d'eux mêmes.
Signaler
phoenix14
Messages postés
15
Date d'inscription
vendredi 10 mai 2002
Statut
Membre
Dernière intervention
3 décembre 2007
Super !
Presque tout ce qu'il me fallait :))
Par contre, si jamais quelqu'un savait comment modifier une "zone de texte", je suis preneur, j'ai tenté plein de truc sans résultat...:'(
Afficher les 64 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Jacques PRESTREAU)