Piloter word par ole avec access ou vb
Soyez le premier à donner votre avis sur cette source.
Snippet vu 85 496 fois - Téléchargée 69 fois
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
Faites un test en mode pas à pas (F8) avec la procédure Word_test.
Vous m'en direz des nouvelles !
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
- Www.groupemalakoff.com
- Ou ole - Meilleures réponses
- Ole ou - Meilleures réponses
- Piloter excel par ole avec access ou vb - Codes sources - Visual Basic / VB.NET (VBA)
- Ouvrir un champ OLE Access via VB ✓ - Forum - Visual Basic 6
- Access to vb - Conseils pratiques - Visual Basic / VB.NET
- Piloter word depuis excel vba - Forum - Visual Basic 6
- Access : combinaison vb + sql pour créer une requête - Codes sources - Visual Basic / VB.NET (Base de Donnees)
Commentaires
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
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,
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.
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...:'(
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.