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

probleme sur une macro EMAIL

  • Initiateur de la discussion Initiateur de la discussion castlevania
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

C

castlevania

Guest
Bonjour,

Je me tourne vers les spécialistes Excel car je rencontre un petit soucis:


j'ai trouvé sur internet une macro qui correspondrait à mes besoins en EMAIL envoyé par EXCEL.

elle fonctionne très bien sur une feuille contenant 7 lignes mais pose un problème par transposition sur ma feuille qui peut en contenir +500.



En colonne B, j'ai une valeur qui déclenche ou non l'envoi d'un EMAIL, si cette valeur est supérieur à 200.

le soucis avec la transposition a mon fichier, c'est que j'ai augmenter

"Set FormulaRange = Me.Range("b8:b500")"

ce qui fait que dès que je touche a ma feuille, excel se met à calculer.

Y'a til un moyen de lui imposer la ligne "en cours" uniquement?

voiçi le code:

Private Sub Worksheet_Calculate()
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Double

NotSentMsg = "RAS"
SentMsg = "envoyé"

'Above the MyLimit value it will run the macro
MyLimit = 200

'Set the range with Formulas that you want to check
Set FormulaRange = Me.Range("b8:b500")

On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
With FormulaCell
If IsNumeric(.Value) = False Then
MyMsg = "Not numeric"
Else
If .Value > MyLimit Then
MyMsg = SentMsg
If .Offset(0, 1).Value = NotSentMsg Then
Call Mail_with_outlook2
End If
Else
MyMsg = NotSentMsg
End If
End If
Application.EnableEvents = False
.Offset(0, 1).Value = MyMsg
Application.EnableEvents = True
End With
Next FormulaCell

ExitMacro:
Exit Sub

EndMacro:
Application.EnableEvents = True

MsgBox "une erreur est survenu." _
& vbLf & Err.Number _
& vbLf & Err.Description

End Sub



j'aimerais que cette macro ne rafraichisse pas toutes les lignes mais seulement celle active.

Je vous joins un fichier de démonstration. Ce serait vraiment gentil de m'aider

Merci de votre aide précieuse.
 

Pièces jointes

Re : probleme sur une macro EMAIL

Bonjour Castlevania,

Pourquoi ne pas faire ça sur un Worksheet_change plutôt que Calculate 😕

Sinon le code pas vraiment optimisé, mais qui devrait fonctionner 😉
Code:
[COLOR=BLUE]Private Sub[/COLOR] Worksheet_Change([COLOR=BLUE]ByVal[/COLOR] Target [COLOR=BLUE]As[/COLOR] Range)
  [COLOR=BLUE]Dim[/COLOR] FormulaRange [COLOR=BLUE]As[/COLOR] Range
  [COLOR=BLUE]Dim[/COLOR] NotSentMsg [COLOR=BLUE]As String[/COLOR]
  [COLOR=BLUE]Dim[/COLOR] MyMsg [COLOR=BLUE]As String[/COLOR]
  [COLOR=BLUE]Dim[/COLOR] SentMsg [COLOR=BLUE]As String[/COLOR]
  [COLOR=BLUE]Dim[/COLOR] MyLimit [COLOR=BLUE]As Double[/COLOR]
  NotSentMsg = "RAS"
  SentMsg = "envoyé"
 [COLOR=GREEN] 'Above the MyLimit value it will run the macro[/COLOR]
  MyLimit = 200
 [COLOR=GREEN] 'Set the range with Formulas that you want to check[/COLOR]
  [COLOR=BLUE]Set[/COLOR] FormulaRange = Me.Range("B" & Selection.Row)
  [COLOR=BLUE]On Error GoTo[/COLOR] EndMacro:
  [COLOR=BLUE]For Each[/COLOR] FormulaCell [COLOR=BLUE]In[/COLOR] FormulaRange.Cells
    [COLOR=BLUE]With[/COLOR] FormulaCell
      [COLOR=BLUE]If[/COLOR] IsNumeric(.Value) = [COLOR=BLUE]False Then[/COLOR]
        MyMsg = "Not numeric"
      [COLOR=BLUE]Else[/COLOR]
        [COLOR=BLUE]If[/COLOR] .Value > MyLimit [COLOR=BLUE]Then[/COLOR]
          MyMsg = SentMsg
          [COLOR=BLUE]If[/COLOR] .Offset(0, 1).Value = NotSentMsg [COLOR=BLUE]Then[/COLOR]
            [COLOR=BLUE]Call[/COLOR] Mail_with_outlook2
          [COLOR=BLUE]End If[/COLOR]
        [COLOR=BLUE]Else[/COLOR]
          MyMsg = NotSentMsg
        [COLOR=BLUE]End If[/COLOR]
      [COLOR=BLUE]End If[/COLOR]
      Application.EnableEvents = [COLOR=BLUE]False[/COLOR]
      .Offset(0, 1).Value = MyMsg
      Application.EnableEvents = [COLOR=BLUE]True[/COLOR]
    [COLOR=BLUE]End With[/COLOR]
  [COLOR=BLUE]Next[/COLOR] FormulaCell
ExitMacro:
  [COLOR=BLUE]Exit Sub[/COLOR]
EndMacro:
  Application.EnableEvents = [COLOR=BLUE]True[/COLOR]
  MsgBox "une erreur est survenu." _
       & vbLf & Err.Number _
       & vbLf & Err.Description
[COLOR=BLUE]End Sub[/COLOR]
[size=-2]Pour des codes plus lisible - Code créé par MRomain[/size]

A+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
4
Affichages
732
Réponses
5
Affichages
909
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…