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
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.
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 '----------------------------------------------------------
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 = ""adresse@domaine.fr"""
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
'----------------------------------------------------------
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 '----------------------------------------------------------
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 '--------------------------------------------------------------------
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 = ""adresse@domaine.fr"""
'***************************************************************
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
'--------------------------------------------------------------------
(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 '--------------------------------------------------------------------
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 '--------------------------------------------------------------------
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 = ""adresse@domaine.fr"""
'***************************************************************
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
'--------------------------------------------------------------------
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 '--------------------------------------------------------------------
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 '--------------------------------------------------------------------
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 =
""adresse@domaine.fr"
'--------------------------------------------------------------------
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 = ""adresse@domaine.fr"""
'***************************************************************
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
'--------------------------------------------------------------------
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 '--------------------------------------------------------------------
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...
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...
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...
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...!
| 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...!
| 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...!