OVH Cloud OVH Cloud

Ajouter une ligne de code dans une macro

17 réponses
Avatar
Fredo(67)
Bonjour,

j'ai une macro que j'ai cr=E9=E9 pour des coll=E8gues.
(cette macro est utilis=E9e pour envoyer automatiquement des mails depuis e=
xcel)

Dans cette macro je souhaite ins=E9rer la ligne suivante

msg.SentOnBehalfOfName =3D "adresse@domaine.fr"

la partie de code consid=E9r=E9e passant de
msg.To =3D ActiveCell.Value
msg.CC =3D DestinatairesEnCc

=E0 =20
msg.To =3D ActiveCell.Value
msg.SentOnBehalfOfName =3D "adresse@domaine.fr"
msg.CC =3D DestinatairesEnCc


Je voudrais pouvoir faire cette modification depuis excel, par une macro en=
registr=E9e dans le Personal.xlb
parcequ'en fait elle doit =EAtre effectu=E9e sur un grand nombre de fichier=
.

Comment cela pourrait il se faire ?

dans un autre fil de discussion quelqu'un a proposer de supprimer tout le m=
odule contenant la macro =E0 modifier pour r=E9importer un module contenant=
la macro mise =E0 jour, mais je bloque quasiment =E0 la premi=E8re ligne p=
ar un code d'erreur

voil=E0 ce que j'ai test=E9 :

Sub MacroQuiTransformeMacro()
Application.VBE.ActiveVBProject.VBComponents.Remove
' Application.VBE.ActiveVBProject.VBComponents.Remove
Application.VBE.ActiveVBProject.VBComponents ("Autrefichier")
Application.VBE.ActiveVBProject.VBComponents.Import "I:\Conduite\AA HIR=
TZ\Envoi_depuis_contact_tce.bas"
End Sub

7 réponses

1 2
Avatar
DanielCo
Non justement,
Il fait bien la modification, et à la fin une fenêtre apparaît, avec le
bouton débogage grisé....

Strange..



Mets un point d'arrêt devant "Next Module", tu sauras au moins dans quel module
ça se produit.
Avatar
MichD
Bonjour,

As-tu essayé cette approche : à tester...

Remplace la ligne de code spécifiée dans tous les modules si elle existe

'----------------------------------------------------------
Sub RemplacerUneLigneDeCode()

Dim LigneRecherchée As String, RemplacéPar As String
Dim VbComps As Object, VbComp As Object
Dim i As Long, j As Long, Nb As Long, NLigne As Long
Dim Wk As Workbook

Set Wk = ThisWorkbook 'OU UN AUTRE CLASSEUR OUVERT (Workbooks("NomDuClasseur.xlsm")

'*******************2 Variables à définir*********************
'Insère la ligne de code juste au-dessus de la ligne où tu voudrais
'ajouter la ligne de code, dans l'exemple de ta question
LigneRecherchée = "msg.To = " & ActiveCell.Value

'Tu remplaces la ligne recherchée par celle que tu cherches PLUS
'LA NOUVELLE LIGNE À AJOUTER
RemplacéPar = "msg.To = " & ActiveCell.Value & Chr(10) & _
"msg.SentOnBehalfOfName = """""

Set VbComps = Wk.VBProject.VBComponents

On Error Resume Next
For Each VbComp In Wk.VBProject.VBComponents
Nb = VbComp.CodeModule.CountOfLines
For i = 1 To Nb
NLigne = VbComps(i).CodeModule.CountOfLines
For j = 1 To NLigne
If VbComps(i).CodeModule.Lines(j, 1) = LigneRecherchée Then
VbComps(i).CodeModule.DeleteLines j
VbComps(i).CodeModule.InsertLines j, RemplacéPar
j = j + 1
End If
Next j
Next i
Next
Set VbComp = Nothing: Set VbComps = Nothing

End Sub
'----------------------------------------------------------
Avatar
MichD
Ceci est un code plus présentable... ;-))

(Le copier-coller de vieilles procédures n'est pas idéal)

'--------------------------------------------------------------------
Sub RemplacerUneLigneDeCode()

Dim LigneRecherchée As String, RemplacéPar As String
Dim VbComp As VBComponent, VbComps As VBComponents
Dim j As Long, Nb As Long, Wk As Workbook

Set Wk = ThisWorkbook 'OU UN AUTRE CLASSEUR OUVERT (Workbooks("NomDuClasseur.xlsm")

'*******************2 Variables à définir*********************
'Insère la ligne de code juste au-dessus de la ligne où tu voudrais
'ajouter la ligne de code, dans l'exemple de ta question
LigneRecherchée = "msg.To = " & ActiveCell.Value

'Tu remplaces la ligne recherchée par celle que tu cherches PLUS
'LA NOUVELLE LIGNE À AJOUTER
RemplacéPar = "msg.To = " & ActiveCell.Value & Chr(10) & _
"msg.SentOnBehalfOfName = """""
'***************************************************************

Set VbComps = Wk.VBProject.VBComponents
Nb = VbComps.Count
For Each VbComp In Wk.VBProject.VBComponents
With VbComp
Nb = .CodeModule.CountOfLines
Do While j <> Nb
j = j + 1
If .CodeModule.Lines(j, 1) = LigneRecherchée Then
.CodeModule.DeleteLines j
.CodeModule.InsertLines j, RemplacéPar
End If
Loop
Nb = 0
End With
Next
Set VbComp = Nothing: Set VbComps = Nothing

End Sub
'--------------------------------------------------------------------
Avatar
MichD
Une petite coquille à corriger...
J'ai ajouté à la procédure cette ligne de code dans la boucle :
Nb = Nb + 1

Explication : Si on ajoute une ligne, il faut ajouter une ligne au nombre total
de lignes de code du module pour être complet!


'--------------------------------------------------------------------
Sub RemplacerUneLigneDeCode()

Dim LigneRecherchée As String, RemplacéPar As String
Dim VbComp As VBComponent, VbComps As VBComponents
Dim j As Long, Nb As Long, Wk As Workbook

Set Wk = ThisWorkbook 'OU UN AUTRE CLASSEUR OUVERT (Workbooks("NomDuClasseur.xlsm")

'*******************2 Variables à définir*********************
'Insère la ligne de code juste au-dessus de la ligne où tu voudrais
'ajouter la ligne de code, dans l'exemple de ta question
LigneRecherchée = "msg.To = " & ActiveCell.Value

'Tu remplaces la ligne recherchée par celle que tu cherches PLUS
'LA NOUVELLE LIGNE À AJOUTER
RemplacéPar = "msg.To = " & ActiveCell.Value & Chr(10) & _
"msg.SentOnBehalfOfName = """""
'***************************************************************

Set VbComps = Wk.VBProject.VBComponents
Nb = VbComps.Count
For Each VbComp In Wk.VBProject.VBComponents
With VbComp
Nb = .CodeModule.CountOfLines
Do While j <> Nb
j = j + 1
If .CodeModule.Lines(j, 1) = LigneRecherchée Then
.CodeModule.DeleteLines j
.CodeModule.InsertLines j, RemplacéPar
Nb = Nb + 1
End If
Loop
Nb = 0
End With
Next
Set VbComp = Nothing: Set VbComps = Nothing

End Sub
'--------------------------------------------------------------------
Avatar
MichD
La vraie procédure est celle-ci.
Cela aurait été plus court et facile d'écrire une nouvelle procédure plutôt qu'adapter une vieille
procédure!

Cette procédure identifie les occurrences de la ligne de code "msg.To = " & ActiveCell.Value" et
ajoute
une ligne de code à cette dernière. La ligne ajoutée est "msg.SentOnBehalfOfName =
"""

'--------------------------------------------------------------------
Sub RemplacerUneLigneDeCode()

Dim LigneRecherchée As String, RemplacéPar As String
Dim VbComp As Object, j As Long, Nb As Long

Set Wk = ThisWorkbook 'OU UN AUTRE CLASSEUR OUVERT (Workbooks("NomDuClasseur.xlsm")

'*******************2 Variables à définir*********************
'Insère la ligne de code juste au-dessus de la ligne où tu voudrais
'ajouter la ligne de code, dans l'exemple de ta question
LigneRecherchée = "msg.To = " & ActiveCell.Value

'Tu remplaces la ligne recherchée par celle que tu cherches PLUS
'LA NOUVELLE LIGNE À AJOUTER
RemplacéPar = "msg.To = " & ActiveCell.Value & Chr(10) & _
"msg.SentOnBehalfOfName = """""
'***************************************************************

For Each VbComp In Wk.VBProject.VBComponents
With VbComp
Nb = .CodeModule.CountOfLines
Do While j <> Nb
j = j + 1
If .CodeModule.Lines(j, 1) = LigneRecherchée Then
.CodeModule.DeleteLines j
.CodeModule.InsertLines j, RemplacéPar
'La ligne suivante est utilise seulement dans le cas où on remplace
'une ligne de code par 2 lignes.
Nb = Nb + 1
End If
Loop
Nb = 0: j = 0
End With
Next
Set VbComp = Nothing: Set Wk = Nothing

End Sub
'--------------------------------------------------------------------
Avatar
Fredo(67)
Salut

Je suis d'accord avec toi concernant le fait de partir d'une feuille vierge et d'écrire toute la procédure, au lieu de pomper et d'adapter une pro cédure existante.

Mais comme je ne veux pas trop vous faire c###r et être un minimum autono me, c'est le seul moyen que j'ai quand cela aborde un thème que je ne con nais pas
ici : modifier une macro par un code VBA..


Pour ton code, merci beaucoup, je vais tester ça...
Avatar
MichD
| Je suis d'accord avec toi concernant le fait de partir d'une feuille vierge et d'écrire toute la
procédure

C'est un commentaire que je faisais tout haut quant à ma manière de répondre aux questions
soulevées.
Souvent, il serait préférable de recommencer à écrire la procédure que de tenter d'adapter une
procédure
que j'ai dans ma bibliothèque! Je ne suis pas sûr d'économiser beaucoup de temps...!
1 2