Soyez le premier à donner votre avis sur cette source.
Snippet vu 85 679 fois - Téléchargée 69 fois
'© 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
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.