Hesekiel02
XLDnaute Nouveau
Bonjour , je suis novice en codage , je préviens tout de suite^^
J'ai actuellement un tableau excel sur lequel j'ai créé une macro prenant les valeurs de différentes cellules afin de les exporter dans un courrier type word.
Il est construit ainsi par exemple : en Z2 est placé un bouton de lancement de la macro qui va chercher les infos en A2, en B2, en C2 etc sur plusieurs colonnes de la même ligne . Le problème c'est que ma macro est à constantes fixes , et j'aurais besoin que lorsque que le bouton est sur la 2ème ligne, elle prenne les infos des colonnes spécifiées sur la 2eme ligne, quand le bouton est sur la ligne 3 , la macro prenne les infos des mêmes colonnes de la lignes de 3 etc...
je vous mets le code ma macro ici, j'espère que quelqu'un pourra m'aider ^^:
Sub Excel_vers_Word()
Dim WordApp As Object, WordDoc As Object
Dim NDF As String, NDF2 As String, Rep As String
NDF = ActiveWorkbook.Path & "\Lettre clôture de dossier3Mac - A utiliser.doc"
Rep = ActiveWorkbook.Path & "\DocComplets\"
If Not Exist_Fichier(NDF) Then
MsgBox "Document 'Lettre clôture de dossier3Mac - A utiliser.doc' manquant", vbExclamation, "Charles"
Else
If Not Exist_Rep(Rep) Then MkDir Rep
NDF2 = Rep & "Doc_créé_" & Format(Now(), "yyyymmdd_hhmm") & ".doc"
On Error Resume Next
If Fichier_IsOpen(NDF) Then
Set WordApp = GetObject(, "Word.Application")
Set WordDoc = WordApp.Documents(NDF)
Else
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(NDF, ReadOnly:=True)
End If
With WordApp
.Visible = False
.Selection.GoTo What:=wdGoToBookmark, Name:="Civilité"
.Selection.TypeText Text:=ActiveSheet.Range("B3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Nom"
.Selection.TypeText Text:=ActiveSheet.Range("C3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Prénom"
.Selection.TypeText Text:=ActiveSheet.Range("D3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Adresse"
.Selection.TypeText Text:=ActiveSheet.Range("E3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Ville"
.Selection.TypeText Text:=ActiveSheet.Range("G3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="NumDos"
.Selection.TypeText Text:=ActiveSheet.Range("A3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="LRAR"
.Selection.TypeText Text:=ActiveSheet.Range("W3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Civilité2"
.Selection.TypeText Text:=ActiveSheet.Range("B3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Pièces"
.Selection.TypeText Text:=ActiveSheet.Range("M3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="DateEnv"
.Selection.TypeText Text:=ActiveSheet.Range("S3").Value
End With
WordDoc.Application.ActiveDocument.SaveAs NDF2
WordApp.Visible = True
Set WordDoc = Nothing
Set WordApp = Nothing
MsgBox "Document word prêt"
End If
End Sub
Function Exist_Fichier(S As String) As Boolean
Dim tatiak As Object
Set tatiak = CreateObject("Scripting.FileSystemObject")
Exist_Fichier = tatiak.FileExists(S)
Set tatiak = Nothing
End Function
Function Exist_Rep(NDF As String) As Boolean
On Error Resume Next
Exist_Rep = GetAttr(NDF) And vbDirectory
End Function
Function Fichier_IsOpen(ByRef NDF As String) As Boolean
On Error Resume Next
Open NDF For Input Lock Read As #1
Close #1
Fichier_IsOpen = (Err.Number <> 0)
End Function
J'ai actuellement un tableau excel sur lequel j'ai créé une macro prenant les valeurs de différentes cellules afin de les exporter dans un courrier type word.
Il est construit ainsi par exemple : en Z2 est placé un bouton de lancement de la macro qui va chercher les infos en A2, en B2, en C2 etc sur plusieurs colonnes de la même ligne . Le problème c'est que ma macro est à constantes fixes , et j'aurais besoin que lorsque que le bouton est sur la 2ème ligne, elle prenne les infos des colonnes spécifiées sur la 2eme ligne, quand le bouton est sur la ligne 3 , la macro prenne les infos des mêmes colonnes de la lignes de 3 etc...
je vous mets le code ma macro ici, j'espère que quelqu'un pourra m'aider ^^:
Sub Excel_vers_Word()
Dim WordApp As Object, WordDoc As Object
Dim NDF As String, NDF2 As String, Rep As String
NDF = ActiveWorkbook.Path & "\Lettre clôture de dossier3Mac - A utiliser.doc"
Rep = ActiveWorkbook.Path & "\DocComplets\"
If Not Exist_Fichier(NDF) Then
MsgBox "Document 'Lettre clôture de dossier3Mac - A utiliser.doc' manquant", vbExclamation, "Charles"
Else
If Not Exist_Rep(Rep) Then MkDir Rep
NDF2 = Rep & "Doc_créé_" & Format(Now(), "yyyymmdd_hhmm") & ".doc"
On Error Resume Next
If Fichier_IsOpen(NDF) Then
Set WordApp = GetObject(, "Word.Application")
Set WordDoc = WordApp.Documents(NDF)
Else
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(NDF, ReadOnly:=True)
End If
With WordApp
.Visible = False
.Selection.GoTo What:=wdGoToBookmark, Name:="Civilité"
.Selection.TypeText Text:=ActiveSheet.Range("B3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Nom"
.Selection.TypeText Text:=ActiveSheet.Range("C3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Prénom"
.Selection.TypeText Text:=ActiveSheet.Range("D3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Adresse"
.Selection.TypeText Text:=ActiveSheet.Range("E3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Ville"
.Selection.TypeText Text:=ActiveSheet.Range("G3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="NumDos"
.Selection.TypeText Text:=ActiveSheet.Range("A3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="LRAR"
.Selection.TypeText Text:=ActiveSheet.Range("W3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Civilité2"
.Selection.TypeText Text:=ActiveSheet.Range("B3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="Pièces"
.Selection.TypeText Text:=ActiveSheet.Range("M3").Value
.Selection.GoTo What:=wdGoToBookmark, Name:="DateEnv"
.Selection.TypeText Text:=ActiveSheet.Range("S3").Value
End With
WordDoc.Application.ActiveDocument.SaveAs NDF2
WordApp.Visible = True
Set WordDoc = Nothing
Set WordApp = Nothing
MsgBox "Document word prêt"
End If
End Sub
Function Exist_Fichier(S As String) As Boolean
Dim tatiak As Object
Set tatiak = CreateObject("Scripting.FileSystemObject")
Exist_Fichier = tatiak.FileExists(S)
Set tatiak = Nothing
End Function
Function Exist_Rep(NDF As String) As Boolean
On Error Resume Next
Exist_Rep = GetAttr(NDF) And vbDirectory
End Function
Function Fichier_IsOpen(ByRef NDF As String) As Boolean
On Error Resume Next
Open NDF For Input Lock Read As #1
Close #1
Fichier_IsOpen = (Err.Number <> 0)
End Function