Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Incrémenter une variable en fonction de la ligne où se trouve le bouton de commande

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
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

Pourquoi ne pas simplement faire un publipostage avec des champs conditionnels
(de nombreux exemples sur le net)
Et cela se fait sans macros, tout se pilote à la souris.

Sinon pour infos (pour obtenir quelques infos par rapport au bouton cliqué, un petit exemple ci-dessous
VB:
Sub InfoBoutonCliqué()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
MsgBox shp.TopLeftCell.Row
MsgBox shp.TopLeftCell.Address
MsgBox shp.TopLeftCell.Column
MsgBox shp.Name
End Sub
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…