XL 2010 Help Bouton pour ouvrir word

safranien

XLDnaute Occasionnel
Bonjour à tous,

soit le fichier ci-joint dans lequel j'uovre un word en cliquant sur le bouton. Jusqu'ici c'est déjà un exploit pour moi d'avoir réussi à faire cela vu que je ne comprends pas vraiement le VBA (et pourtant j'essaie j'essaie..).

En complément, est ce possible d'ajouter :

_ comment écrire de reconnaitre un fichier word quelqu'il soit et pas seulement un word en docm? Il es tpossible que dans ce dossier soient enregistrés des Word en docx et docm

_ à côté du nom du site choisi dans le menu déroulant, qu'un code puisse contrôler en arrière plan si le word existe dans le dossier (en retournant par exemple une valeur 0 ou 1 dans une cellule). Ce qui éviterait de cliquer sur le bouton d'open word pour rien. Un point important, le fichier pour lequel se destine ce code est en calcul manuel.

_ si malgré tout l'utilisateur clique sur le bouton par mégarde alors qu'il n'y a pas de document disponible, est ce possible d'avoir un message disant "Pas de document trouvé" sans que la macro ne plante?

_ si le document est déjà ouvert, basculer directement sur le document plutôt que de l'ouvrir une 2e fois en lecture seule

Enfin, savez vous si dans Word il est possible d'avoir une sorte de bouton flottant qui serait visible sur toutes les pages et qui permettrait, en cliquant dessus, d'enregistrer le word en PDF directement à un endroit et avec un certain nom?

Pouvez vous m'aider svp?
 

Pièces jointes

  • Site 1 - Analyses - 2020.docm
    15.1 KB · Affichages: 8
  • Site 2 - Analyses - 2020.docm
    15 KB · Affichages: 1
  • Site 3 - Analyses - 2020.docm
    15 KB · Affichages: 1
  • essai open word.xlsm
    17 KB · Affichages: 6
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour safranien,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Voyez cette macro dans le code de la 1ère feuille du fichier Excel :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:B1]) Is Nothing Or [A1] = "" Then Exit Sub
Dim chemin$, doc$, Wapp As Object
chemin = ThisWorkbook.Path & "\" 'dossier à adapter éventuellement
doc = Dir(chemin & [A1] & "*" & [B1] & ".doc*") '1er fichier trouvé
If doc = "" Then MsgBox "Document Word introuvable !", 48: Exit Sub
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
On Error GoTo 0
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Wapp.Documents.Open chemin & doc
AppActivate "Word"
End Sub
Elle s'exécute quand on modifie le Site en A1 ou l'année en B1.

Comme demandé j'ai mis un CommandButton dans chaque document Word ainsi que sa macro qui permet de créer un document PDF :
VB:
Private Sub CommandButton1_Click() 'PDF
With ThisDocument
    .ExportAsFixedFormat Left(.FullName, InStr(.FullName, ".")) & "pdf", wdExportFormatPDF
End With
End Sub
Le bouton n'est pas "flottant", il faudra en mettre un dans chaque page.

A+
 

Pièces jointes

  • Open word(1).xlsm
    19.3 KB · Affichages: 6
  • Site 1 - Analyses - 2020.docm
    20.1 KB · Affichages: 3
  • Site 2 - Analyses - 2020.docm
    20 KB · Affichages: 3
  • Site 3 - Analyses - 2020.docm
    18.6 KB · Affichages: 3

safranien

XLDnaute Occasionnel
Bonjour Job75

merci beaucoup pour votre aide. Je tente d'adapter à mon fichier de travail et rencontre des difficultés.
Ci-joint le fichier remanié en conséquence (j'ai modifié le chemin pour récupérer les word, placés dans un sous dossier). Dans mon fichier de travail, j'ai un menu déroulant sur 10 onglets, tous situés en A1. Je peux sélectionner un site via ce menu dans n'importe quel onglet et une macro recopie la nouvelle valeur choisie sur tous les onglets du classeur.
L'année est située sur un autre onglet que ceux ayant des menus déroulant (ici en Feuil5).
Je souhaite conserver le bouton pour ouvrir les word et non pas une ouverture automatique après sélection du site.

Pour finir, lorsqu'on clique sur le bouton de mise en PDF du Word, est ce possible d'avoir une fenêtre qui dise que le PDF a été créé avec 3 boutons "Fermer" (la fenêtre), "Ouvrir le dossier" (contenant le PDF) et "Ouvrir" (le PDF) ?
 

Pièces jointes

  • Open word(2).xlsm
    22.3 KB · Affichages: 3

job75

XLDnaute Barbatruc
Voyez ce fichier (2) avec dans ThisWorkbook (il n'y a plus de macros dans les feuilles) :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Sh.Range("A1").Validation.Formula1 <> "=Liste" Then Exit Sub
Dim w As Worksheet
Application.EnableEvents = False
For Each w In Worksheets
    If w.Range("A1").Validation.Formula1 <> "=Liste" Then Else w.Range("A1") = Sh.Range("A1")
Next
Application.EnableEvents = True
End Sub
Et dans Module1 la macro affectée aux 4 boutons :
VB:
Sub Word()
Dim chemin$, doc$, Wapp As Object
chemin = ThisWorkbook.Path & "\PASTEL Analyses\" 'dossier à adapter éventuellement
doc = Dir(chemin & [A1] & "*" & Feuil5.[D12] & ".doc*") '1er fichier trouvé
If doc = "" Then MsgBox "Document Word introuvable !", 48: Exit Sub
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
On Error GoTo 0
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Wapp.Documents.Open chemin & doc
AppActivate "Word"
End Sub
 

Pièces jointes

  • Open word(2).zip
    73.9 KB · Affichages: 6

safranien

XLDnaute Occasionnel
Merci beaucoup Job75 !!!!! Ca à l'air de parfaitement fonctionner.
J'ai créé des sous-dossiers par année et réussi à modifier le code en conséquence:

VB:
chemin = ThisWorkbook.Path & "\PASTEL Analyses\" & X_Feuil10.[B11] & "\"  'dossier à adapter éventuellement

Pour perfectionner la démarche, est ce possible que, si le word n'existe pas pour un site choisi, la macro d'excel le créée, à partir par exemple d'un word vierge qui serait logé dans le dossier PASTEL Analyse? Mes word ont une zone texte en en-tête, dans laquelle j'inscit "Site1 - Analyse - année". Est ce que la macro pourrait également inscrire cela dans la zone texte de l'en-tête lors de la création du word?


Merci encore et bonne soirée
 
Dernière édition:

Discussions similaires

Réponses
4
Affichages
498
Réponses
2
Affichages
765

Statistiques des forums

Discussions
314 735
Messages
2 112 306
Membres
111 503
dernier inscrit
Finearts