probleme sur une macro EMAIL

[castlevania]

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.

 

[Compte Supprimé 979]

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

[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+

 

[castlevania]

Re : probleme sur une macro EMAIL

Bonne question ^^

En tout cas cela semble marcher au poil !

Merci à toi !