Discussion :

[Montail31]

Bonjour,

j'ai créé un document word avec du code VBA pour faire des copier coller en automatique. J'ai enregistré sous "modèle prenant en charge les macro".

J'ai un bouton pour exécuter la macro qui fonctionne.

Le document est sur le réseau, lorsque j'ouvre le document, le bouton pour exécuter la macro ne fonctionne plus.

J'aimerai avoir un bouton, un menu ou tout autre chose, qui me permette d'exécuter la macro depuis le document généré depuis le modèle.

J'ai essayé de faire un menu, mais ça ne fonctionne pas non plus . Merci de votre aide le code ci dessous et la pièce joint pour vous montrer ou est enregistrer la macro

voici le code


Sub AddCustomMenu()
Dim menuBar As Object
Dim newMenu As Object
Dim newMenuItem As Object

' Supprimer le menu personnalisé s'il existe déjà pour éviter les doublons
On Error Resume Next
Application.CommandBars("MenuBar").Controls("Prévention").Delete
On Error GoTo 0

' Ajouter un nouveau menu dans la barre de menus
Set menuBar = Application.CommandBars("MenuBar")
Set newMenu = menuBar.Controls.Add(Type:=msoControlPopup, Temporary:=True)
newMenu.Caption = "Prévention"
newMenu.Tag = "PreventionMenu"

' Ajouter un sous-menu pour le PV avec une macro associée
Set newMenuItem = newMenu.Controls.Add(Type:=msoControlButton, Before:=1)
newMenuItem.Caption = "Générer le PV"
newMenuItem.Tag = "GénérerlePVMenuItem"
newMenuItem.OnAction = "CopierColler" ' Remplacez "NomDeVotreMacro" par le nom de votre macro

' Enregistrer les modifications dans le document modèle
ThisDocument.Save
End Sub


Sub CopierColler()
Dim Doc As Document
Set Doc = ActiveDocument

' Copier le texte entre "sommaire de l'établissement" et "conception des bâtiments"
CopierCollerEntreBalises Doc, "Copier début descriptif", "Copier fin descriptif", _
"Coller début descriptif", "Coller fin descriptif"

' Supprimer les balises après le collage


' Copier le texte entre "proposition d'avis du groupe" et "prescriptions"
CopierCollerEntreBalises Doc, "Copier début avis", "Copier fin analyse", _
"Coller début avis", "Coller fin analyse"

' Supprimer les balises après le collage


' Copier le texte entre "ci-après" et "règlement en vigueur"
CopierCollerEntreBalises Doc, "Copier début prescriptions", "Copier fin prescriptions", _
"Coller début prescriptions", "Coller fin prescriptions"

' Supprimer les balises après le collage
Call SupprimerPhrasesPrecises

End Sub

Sub CopierCollerEntreBalises(Doc As Document, debutBalise As String, finBalise As String, _
debutCollerBalise As String, finCollerBalise As String)
' Déclaration des variables



Dim debutRange As Range
Dim finRange As Range
Dim texteCopie As Range

' Sélection du texte entre les balises
Set debutRange = Doc.Range
debutRange.Find.Text = debutBalise
debutRange.Find.Execute
Set finRange = Doc.Range
finRange.Find.Text = finBalise
finRange.Find.Execute

' Copier le texte entre les balises
Set texteCopie = Doc.Range(debutRange.End, finRange.Start)
texteCopie.Copy

' Coller le texte entre les balises de collage
debutRange.Find.Text = debutCollerBalise
debutRange.Find.Execute
Set finRange = Doc.Range
finRange.Find.Text = finCollerBalise
finRange.Find.Execute
finRange.Paste
End Sub

Sub SupprimerPhrasesPrecises()
' Déclaration des variables
Dim Doc As Document
Set Doc = ActiveDocument

' Phrases à supprimer (ajoutez autant de phrases que nécessaire)
Dim phrasesASupprimer As Variant
phrasesASupprimer = Array("Copier début descriptif", "Copier fin descriptif", _
"Coller début descriptif", "Coller fin descriptif", "Copier début avis", "Copier fin analyse", _
"Coller début avis", "Coller fin analyse", "Copier début prescriptions", "Copier fin prescriptions", _
"Coller début prescriptions", "Coller fin prescriptions")

' Boucle pour supprimer chaque phrase spécifiée
Dim i As Integer
For i = LBound(phrasesASupprimer) To UBound(phrasesASupprimer)
SupprimerPhraseSpecifique Doc, CStr(phrasesASupprimer(i))
Next i
End Sub

Sub SupprimerPhraseSpecifique(Doc As Document, ByVal phrase As String)
' Déclaration des variables
Dim phraseRange As Range

' Rechercher la phrase à supprimer
Set phraseRange = Doc.Range
phraseRange.Find.Text = phrase
phraseRange.Find.Forward = True
phraseRange.Find.MatchWholeWord = True
phraseRange.Find.Execute

' Supprimer toutes les occurrences de la phrase trouvée
Do While phraseRange.Find.Found
phraseRange.Delete
phraseRange.Find.Execute
Loop

End Sub

Private Sub Document_Open()
' Appeler la macro pour afficher le message d'information
Application.OnTime Now + TimeValue("00:00:05"), "AfficherMessageInformation"
End Sub

Sub AfficherMessageInformation()
' Vérifier si la case à cocher "Ne plus afficher ce message" est cochée
Dim settingsKey As String
settingsKey = "NePlusAfficherMessageInformation"

' Utiliser une propriété personnalisée pour stocker la préférence
Dim checkBoxValue As Boolean
On Error Resume Next
checkBoxValue = ActiveDocument.CustomDocumentProperties(settingsKey).Value
On Error GoTo 0

' Afficher le message uniquement si la case à cocher n'est pas cochée
If Not checkBoxValue Then
' Créer la boîte de dialogue personnalisée
Dim response As Integer
response = MsgBox("Cliquer sur le bouton : Générer le PV une fois votre rapport terminé." & vbCrLf & vbCrLf & "Ne plus afficher ce message ?", _
vbInformation + vbYesNo, "Message d'information Montailler SDIS31 - 2024")

' Si l'utilisateur clique sur "Oui" (vbYes), enregistrer la préférence
If response = vbYes Then
ActiveDocument.CustomDocumentProperties.Add Name:=settingsKey, _
LinkToContent:=False, Type:=msoPropertyTypeBoolean, Value:=True
End If
End If
End Sub

[Montail31]

J'arrive à lancer la macro sur mon pc, mais pas de macro visible lorsque je génère un document depuis ce modèle sur un autre pc.

Je ne sais pas comment faire. Merci de votre aide.

[Philippe Tulliez]

Bonjour,
La première fois que j'ai dû développer une application Word avec procédures accessibles à plusieurs utilisateurs, j'ai mis longtemps à trouver

Pour utiliser des macros pouvant servir à d’autres documents, il y a lieu de créer un modèle global (dotm)

• Où placer un modèle global ? dans C:\Users\UserName\AppData\Roaming\Microsoft\Word\STARTUP
• Comment appeler une procédure présente dans le modèle chargé depuis le répertoire StartUp depuis un autre document docm ?
  En référençant le projet (Outils/Références...) et au préalable il est préférable d’avoir renommer le nom du projet
  Si le nom du projet renommé est projAppMenu, la procédure nommée Main dans un module mMain, la ligne de commande sera

  Code :

  Sélectionner tout - Visualiser dans une fenêtre à part

  projAppMenu.mMain.main

  ou bien sans référencer le projet (Appmenu étant le nom du modèle global)

  Code :

  Sélectionner tout - Visualiser dans une fenêtre à part

  Application.Run "Appmenu.dotm!mMain.Main"

  et pour invoquer une fonction

  Code :

  Sélectionner tout - Visualiser dans une fenêtre à part

  sTemp = Application.Run ("modulename.functionname")

  .

[Montail31]

Merci, j'essaie ça au retour de vacances