Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Correction macro

4 réponses
Avatar
Kyvu
Bonjour,

Cette macro est dupliqu=E9e autant de fois qu'il existe de=20
feuilles dans mon classeur:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column =3D 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) =3D Range("B3")
cell.Offset(, 2) =3D Range("C3")
Else
End If
Next
End If
End Sub

Le probl=E8me c'est la maintenance du code: je dois =E0=20
chaque fois corriger toutes les feuilles. Phouuuu,=20
beaucoup boulot!

J'ai bien essay=E9 de d=E9placer le code principal dans un=20
module standard mais =E7a ne marche pas. Je crois que je=20
perds le Target de la cellule quand j'appelle la macro=20
Transfert.

Dans ma feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column =3D 1 Then
Call Transfert
End If
End Sub

Dans mon module standard:

Sub Transfert()
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) =3D Range("B3")
cell.Offset(, 2) =3D Range("C3")
Else
End If
Next
End sub

Quelqu'un a-t-il la solution? Enfin, derni=E8re question:=20
est-il possible de passer la macro Transfert en Private=20
et l'appeler depuis une feuille comme je veux le faire=20
i=E7i?

Merci pour votre aide.

@micalement.



Kyvu On Line!

4 réponses

Avatar
Pascal Engelmajer
Salut,
il faut chercher soit des modules de classe, soit après avoir exporté le
module de code (.bas)
de l'importer dynamiquement feuille par feuille ( ce qui doit passer par
ActiveWorkbook.VBProject.VBComponents.CodeModule. DeleteLines 1,
ActiveWorkbook.VBProject.VBComponents.CodeModule. CountOfLines
et la ré-écriture ligne par ligne - j'ai jamais essayé, mais on peut
peut-êtr, ActiveWorkbook.VBProject.VBComponents.Import )
--
Amicalement.
Pascal
"il n'y a pas de vent favorable pour celui qui ne sait pas ou il va."
Sénèque.
http://www.ilyapa.net/excel
http://www.ilyapa.net/baseExcel
"Kyvu" a écrit dans le message de
news: 1086701c43fdf$6e07d340$
Bonjour,

Cette macro est dupliquée autant de fois qu'il existe de
feuilles dans mon classeur:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End If
End Sub

Le problème c'est la maintenance du code: je dois à
chaque fois corriger toutes les feuilles. Phouuuu,
beaucoup boulot!

J'ai bien essayé de déplacer le code principal dans un
module standard mais ça ne marche pas. Je crois que je
perds le Target de la cellule quand j'appelle la macro
Transfert.

Dans ma feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Call Transfert
End If
End Sub

Dans mon module standard:

Sub Transfert()
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End sub

Quelqu'un a-t-il la solution? Enfin, dernière question:
est-il possible de passer la macro Transfert en Private
et l'appeler depuis une feuille comme je veux le faire
içi?

Merci pour votre aide.

@micalement.



Kyvu On Line!
Avatar
FxM
Bonjour,

Il te faut passer les arguments de nom de feuille et de target.
Non testé :

Dans ma feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
sht = activesheet.name

tar = target.address
Call Transfert(sht,tar)
End If
End Sub

Dans mon module standard:

Sub Transfert(sht,tar)
with sheets(sht)

For Each cell In .Intersect(Columns(1), Tar)
If cell <> "" Then
.cell.Offset(, 1) = .Range("B3")
.cell.Offset(, 2) = .Range("C3")
Else
else quoi ???

End If
Next
end with

End sub


@+
FxM

Avatar
Frédéric Sigonneau
Bonjour,

Tu pourrais essayer d'utiliser l'événement Workbook_SheetChange du module
ThisWorkbook, exécuté par défaut sur la feuille active lorsqu'elle est modifiée
et, donc, applicable à tout ton classeur (si certaines feuilles doivent être
exclues, il faudra adapter un peu) :

'=============== Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
End If
Next
End If
End Sub
'===============
FS
---
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !


Bonjour,

Cette macro est dupliquée autant de fois qu'il existe de
feuilles dans mon classeur:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End If
End Sub

Le problème c'est la maintenance du code: je dois à
chaque fois corriger toutes les feuilles. Phouuuu,
beaucoup boulot!

J'ai bien essayé de déplacer le code principal dans un
module standard mais ça ne marche pas. Je crois que je
perds le Target de la cellule quand j'appelle la macro
Transfert.

Dans ma feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Call Transfert
End If
End Sub

Dans mon module standard:

Sub Transfert()
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End sub

Quelqu'un a-t-il la solution? Enfin, dernière question:
est-il possible de passer la macro Transfert en Private
et l'appeler depuis une feuille comme je veux le faire
içi?

Merci pour votre aide.

@micalement.



Kyvu On Line!


Avatar
Pascal Engelmajer
Salut à tous,
avec VBComponents
Sub reInitMesFeuilles()
Dim t
t = Array("feuil2", "feuil5", "feuil5")
For i = 0 To UBound(t)
With Application.VBE.ActiveVBProject.VBComponents(t(i)).CodeModule
.DeleteLines 1, .CountOfLines
.AddFromFile ("feuille.bas") 'contient les procédures
.CodePane.Window.Close
End With
Next i
End Sub

--
Amicalement.
Pascal
"il n'y a pas de vent favorable pour celui qui ne sait pas ou il va."
Sénèque.
http://www.ilyapa.net/excel
http://www.ilyapa.net/baseExcel
"Frédéric Sigonneau" a écrit dans le
message de news: uVJW4s$
Bonjour,

Tu pourrais essayer d'utiliser l'événement Workbook_SheetChange du module
ThisWorkbook, exécuté par défaut sur la feuille active lorsqu'elle est
modifiée

et, donc, applicable à tout ton classeur (si certaines feuilles doivent
être

exclues, il faudra adapter un peu) :

'=============== > Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)

If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
End If
Next
End If
End Sub
'=============== >
FS
---
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !


Bonjour,

Cette macro est dupliquée autant de fois qu'il existe de
feuilles dans mon classeur:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End If
End Sub

Le problème c'est la maintenance du code: je dois à
chaque fois corriger toutes les feuilles. Phouuuu,
beaucoup boulot!

J'ai bien essayé de déplacer le code principal dans un
module standard mais ça ne marche pas. Je crois que je
perds le Target de la cellule quand j'appelle la macro
Transfert.

Dans ma feuille:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Call Transfert
End If
End Sub

Dans mon module standard:

Sub Transfert()
For Each cell In Intersect(Columns(1), Target)
If cell <> "" Then
cell.Offset(, 1) = Range("B3")
cell.Offset(, 2) = Range("C3")
Else
End If
Next
End sub

Quelqu'un a-t-il la solution? Enfin, dernière question:
est-il possible de passer la macro Transfert en Private
et l'appeler depuis une feuille comme je veux le faire
içi?

Merci pour votre aide.

@micalement.



Kyvu On Line!