1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
| Sub Click()
'
' Click Macro
'
'--------------------------------------------------------------------------------
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
'--------------------------------------------------------------------------------
Dim docWord As Word.Document
Dim appWord As Word.Application
Dim NomBase, fic_doc, cheminW, cheminZ, fichier_source, DocName As String
Dim nom_fichier, Nomsourcebase, message_boite As String
Dim fin, i As Integer
Dim Fichier As String
Dim wordApp As Object
'Définit le classeur fermé servant de base de données
Fichier = "Mon dossier\Coordonnées.xlsm"
'Nom de la feuille dans le classeur fermé
NomFeuille = "Feuil1"
ChDir ActiveWorkbook.Path
'demande du fichier source W
'message_boite = "fichier source du publipostage"
'fic_doc = Application.GetOpenFilename("Fichiers Word (*.doc), *.doc", , message_boite)
fic_doc = "Mon dossier\Consigne générale incendie.doc"
Application.ScreenUpdating = False
'recupération du chemin ou se trouve le doc W pour enregistrement des PDF au meme endroit
fichier_source = ActiveWorkbook.Name
cheminW = Dir(fic_doc)
cheminW = Replace(fic_doc, cheminW, "")
cheminZ = "Mon dossier\Dossier administratif\"
'message_boite = "fichier contenant les nouveaux noms des comptes créers"
'Nomsourcebase = Application.GetOpenFilename("Fichiers Excel (*.csv), *.csv", , message_boite)
'sinon nom du fichier xls source en dure
NomBase = cheminW & "Coordonnées.xlsm"
Set Cn = New ADODB.Connection
'--- Connexion ---
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
.Open
End With
Application.DisplayAlerts = False
Set appWord = New Word.Application
appWord.Visible = True
'Ouverture du document principal Word
Set docWord = appWord.Documents.Open(fic_doc)
'With docWord.MailMerge
'Ouvre la base de données le fichier excel doit avoir sa feuille nommée 'feuil1'
' .OpenDataSource Name:=NomBase, Connection:="Driver={Microsoft Excel Driver (*.xls)};" & "DBQ=" & NomBase & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [Coordonnées$]"
' fin = .DataSource.RecordCount
'End With
MsgBox "cliquez sur ok "
Set wordApp = GetObject(, "Word.Application")
wordApp.Run "Macro1"
End Sub |
Partager