Azuveus
XLDnaute Nouveau
Bonsoir à tous,
Je souhaiterais savoir si il est possible de remplir un tableau excel a partir d'un document word.
Je m'explique, j'ai un document word qui contient un bouton macro VBA et je souhaiterais que lorsque je clique sur ce bouton, il ouvre un fichier Excel, qu'il se positionne dans une case d'un onglet bien defini qu'il remplisse la case et qu'il le sauvegarde.
Voici mon code:
Lorsque j'execute ce code, voila l'erreure :
Que dois-je faire ?
Merci d'avance,
Azuveus.
Je souhaiterais savoir si il est possible de remplir un tableau excel a partir d'un document word.
Je m'explique, j'ai un document word qui contient un bouton macro VBA et je souhaiterais que lorsque je clique sur ce bouton, il ouvre un fichier Excel, qu'il se positionne dans une case d'un onglet bien defini qu'il remplisse la case et qu'il le sauvegarde.
Voici mon code:
VB:
Private Sub CommandButton2_Click()
'Declaration des variables
Dim TitreMail As String
Dim NomFichier As String
Dim NomClient As String
Dim NumFacture As String
Dim TypeDoc As String
Dim Reason As String
Dim Lien As String
Dim Week As String
Dim Month As String
Dim MailFor As String
'Variable pour remplisage du fichier Excel annexe.
Dim Excelapp As Excel.Application
Dim Excelsheet As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim rgFound As Range
Dim X As Integer
'Récupération des variables
TypeDoc = Left(ActiveDocument.Tables(1).Cell(1, 2).Range.Text, Len(ActiveDocument.Tables(1).Cell(1, 2).Range.Text) - 1)
NomClient = Left(ActiveDocument.Tables(1).Cell(2, 2).Range.Text, Len(ActiveDocument.Tables(1).Cell(2, 2).Range.Text) - 1)
NumFacture = Left(ActiveDocument.Tables(1).Cell(6, 2).Range.Text, Len(ActiveDocument.Tables(1).Cell(6, 2).Range.Text) - 1)
Reason = ActiveDocument.Tables(1).Cell(9, 2).Range.Text
Lien = "\\....\DEMANDE_2021"
NomFichier = Left(TypeDoc, Len(TypeDoc) - 1) & " - " & Left(NomClient, Len(NomClient) - 1) & " - " & Left(NumFacture, Len(NumFacture) - 1)
TitreMail = "REQUEST FOR CREDIT - " & NomClient & " - " & TypeDoc & " - FA " & NumFacture
Week = Left(ActiveDocument.Tables(2).Cell(2, 1).Range.Text, Len(ActiveDocument.Tables(2).Cell(2, 1).Range.Text) - 1)
Month = Left(ActiveDocument.Tables(2).Cell(2, 2).Range.Text, Len(ActiveDocument.Tables(2).Cell(2, 2).Range.Text) - 1)
MailFor = Left(ActiveDocument.Tables(2).Cell(2, 3).Range.Text, Len(ActiveDocument.Tables(2).Cell(2, 3).Range.Text) - 1)
' Blocage du bouton si le mail n'est pas renseigné.
If MailFor <> "Choose an item." Then
'Initialisation du doc Excel
Set Excelapp = CreateObject("Excel.application")
Excelapp.Visible = False
Set Exceldoc = Excelapp.Documents.Open("\\....\DOA.xlsx")
'Remplissage du document Excel
Set xlSheet = xlBook.Sheets(Month) 'ici feuille du classeur
Set rgFound = xlSheet.Range("C15:C100").Find(Week)
xlSheet.Range("A" & rgFound.Row + 1).Select
xlSheet.Selection.EntireRow.Insert
X = xlSheet.ActiveCell.Row
xlSheet.Range("B" & X) = TypeDoc
'Sauvegarde du tableau excel.
Excelapp.Workbooks.Save
'Sauvegarde une copie du fichier sur le Groupe G
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
"\\....\" & NomFichier & ".pdf", ExportFormat:= _
17, OpenAfterExport:=False, OptimizeFor:= _
0, Range:=0, From:=1, To:=1, _
Item:=0, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=0, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
Dim ol As Object, monItem As Object
Set ol = CreateObject("outlook.application")
Set monItem = ol.CreateItem(olMailItem)
monItem.To = MailFor
monItem.CC = "mail@xxx.com"
monItem.Subject = TitreMail
monItem.HTMLBody = "Bonjour,<br /><br /> Veuillez trouver ci-joint la demande valide pour une <b>" & TypeDoc & "</b><br /> Client : <b>" & _
NomClient & "</b><br /> Numero de facture : <b>" & NumFacture & "</b><br />Raison : <b>" & Reason & "</b></b><br /><br />Une copie de ce fichier est enregistre sur le groupe G. <br /> Dossier de sauvegarde : " & _
Lien & "<br /><br />Pensez a mettre ce document en Piece jointe sur S.A.P.<br /><br /> Cordialement.<br /><br />Guillaume <br />."
monItem.Attachments.Add ("\\....\" & NomFichier & ".pdf")
monItem.Send
Set ol = Nothing
Else
Set ol = Nothing
MsgBox "Veuillez indiquer le destinataire du mail.", vbExclamation
End If
End Sub
Lorsque j'execute ce code, voila l'erreure :
Que dois-je faire ?
Merci d'avance,
Azuveus.
Dernière édition: