Lancer une macro en fonction d'un texte dans une cellule mais pour colonne

Bonjour

J'essaye de trouver le code pour Lancer une macro en fonction d'un texte dans une cellule mais pour la colonne complète. J'ai ce code ci-dessous qui fonctionne parfaitement mais je n'arrive pas à l'associer à toutes les cellules d'une mémé colonne?

Sub worksheet_change(ByVal target As Range)
Set target = Range("H94")
If target.Value = "commande impossible, autorisation à obtenir de Cédric ou Philippe" Then
Call TestEnvoyerEmail
End If
End Sub

Je cherche à générer un email de demande de validation suite à l'apparition de ce message dans une cellule de la colonne H, j'ai essayé avec une boucle for mais je me suis vautré, manque d'expérience...

Merci d'avance de votre retour cela sera surement simple pour vous mais pas pour moi donc les explications sont les bienvenues

Bonjour,

Voici une proposition d'adaptation.

Je ne sais pas si l'évènement change est approprié ou bien géré. Il est possible de passer par un bouton ou par l'évènement calculate. Sinon, il faudrait cibler une cellule déclenchant la macro qui elle testerait la colonne entière (enfin la partie utilisée) :

Sub worksheet_change(ByVal target As Range)
Set r = intersect(target, columns(8))
if not r is nothing then
    for each cell in r
        If cell.Value like "commande impossible*Cédric ou Philippe" Then
            Call TestEnvoyerEmail
        End If
    next cell
end if
End Sub

Et d'ailleurs, il faudrait ensuite changer les valeurs en H pour ne pas envoyer les mails à chaque fois...

Cdlt,

Bonsoir

Tout d'abord merci de ton retour

J'ai copié tel quel ton code, je n'ai pas vu ma macro se lancer sur H94 j'ai ensuite testé sur H95 et la de même cela ne se lance pas. Peut être quelque chose d'autre bloque. Un peu plus d'info sur cette capture

Pour compléter voici mon code envoi email au cas ou un beug s'y cacherait

Sub EnvoyerEmail(ByVal Sujet As String, ByVal Destinataire As String, ByVal ContenuEmail As Variant, Optional ByVal PieceJointe As String)
On Error GoTo EnvoyerEmailErreur

'définition des variables
Dim oOutlook As Outlook.Application
Dim oMailItem As Outlook.MailItem
Dim Body As Variant

Body = ContenuEmail


'préparer Outlook
PreparerOutlook oOutlook
Set oMailItem = oOutlook.CreateItem(0)

'création de l'email
With oMailItem
.To = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"'
.CC = "XXXXXXXXXXXXXXXX"
.Subject = "Demande de validation achat"
'.Body = "file:\\C:"
'CHOIX DU FORMAT
'----------------------
'email formaté comme texte
'.BodyFormat = olFormatRichText
'.Body = Body

'OU

'email formaté comme HTML
.BodyFormat = olFormatHTML
.HTMLBody = "" & Body & ""
'----------------------

'If PieceJointe "" Then .Attachments.Add PieceJointe

.Display '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
'.Save '<- sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire)
.Send '<- envoie l'email (si vous voulez seulement préparer l'email et l'envoyer manuellement, mettez cette ligne en commentaire)
End With

'nettoyage...
If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing

Exit Sub

EnvoyerEmailErreur:
If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing

MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"
End Sub
Private Sub PreparerOutlook(ByRef oOutlook As Object)
'par

'------------------------------------------------------------------------------------------------
'Ce code vérifie si Outlook est prêt à envoyer des emails... Et s'il ne l'est pas, il le prépare.
'------------------------------------------------------------------------------------------------

On Error Resume Next
'vérification si Outlook est ouvert
Set oOutlook = GetObject(, "Outlook.Application")

If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte
Err.Clear
Set oOutlook = CreateObject("Outlook.Application")

If (Err.Number <> 0) Then
MsgBox "Une erreur est survenue lors de l'ouverture de Outlook..."
Exit Sub
Else
End If

Else 'si Outlook est ouvert, l'instance existante est utilisée
End If
End Sub
Sub TestEnvoyerEmail()
'test envoi de l'email sans pièce jointe
Dim Appli As Object
Dim SessionOutlook, myOlApp
Const Chemin As String = "C:\Program Files (x86)\Microsoft Office\Office16\OUTLOOK.exe" ' tu adaptes ce chemin si c'est nécessaire
On Error Resume Next
Set Appli = GetObject(, "Outlook.Application")

'Tester si l'application est ouverte ou non
If Appli Is Nothing Then
MsgBox "Outlook est fermé" '---> Donc ouvre moi une session
SessionOutlook = Shell(Chemin, 1)
End If
Call EnvoyerEmail("Test email 1", "contact@test.fr", "Bonjour,<BR>Une demande de validation achat a été initiée.<br>Cordialement.<br>file:\\W:\DXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX(PML).xlsm")
'test envoi de l'email avec pièce jointe
' Call EnvoyerEmail("Test email 2", "contact@test.fr", "Ceci est un test avec pièce jointe...", "C:\MonDossier\MonFichier.pdf") '

MsgBox "Envoi demande de validation terminé, merci d'indiquer sur la ligne le montant..."

End Sub

Bonjour,

L'évènement change ne fonctionne pas avec les formules, c'est pour ça que je parlais de l'évènement calculate ou de l'exécution avec un bouton, qui me parait plus adaptée dans votre cas.

Pour poster du code, vous pouvez utiliser les balises </> du ruban d'icônes.

Cdlt,

Re

Ah je crois comprendre que ce que tu m'expliques est issue de cette première ligne "Sub worksheet_change(ByVal target As Range)"

Je vais regarder ce que calculate signifie...Je suis surpris car cela fonctionne parfaitement pour une cellule mais que l'on ne puisse reproduire pour un groupe de cellule donc dans mon cas toutes les cellules d'une colonne. Dans un dernier cas je mettrai un bouton mais ce sera avec grand regret car la fluidité du test effectué pour une cellule et le msgbox était très explicite et rapide. Mais bon j'ai une bizarrerie tout de même car en copiant ce même fichier et en l'utilisant sur mon disque dur ou sur un serveur et bien l'appel de la macro ne se lance pas dans le cas du serveur et pas d'erreur. Si je fais lecture dans la fenêtre VBA là ça m'appelle bien TestEnvoyerEmail et l'email s'envoie...Je ne peux pas faire une boucle for et si oui comment pour le code qui marche bien pour une cellule?

Cdlt

Bonsoir Zuul, 3GB,

Pourquoi ne cible tu que H94 ? dans ton code

Bonsoir X Cellus

En fait c'était pour tester et cela fonctionne pour une seule cellule mais ce que je voudrais c'est cibler toute la colonne et je n'y arrive pas besoin d'aide...

Cdlt

Suite,

Place le code ci-dessous dans la partie code de ta feuille.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range, Mot As String
'Nom de l'erreur à chercher pour lancer un message et/ou mail
Mot = "Commande impossible"
Set Cel = Sheets("NomdetaFeuille").Range("H35:H300").Find(Mot, , , xlPart, xlNext)
If Not Cel Is Nothing Then C = Cel.Row: MsgBox "Autorisation nécessaire", vbCritical, "ATTENTION"
End Sub

Si une cellule de ta colonne H ligne 35 à 300 mais tu peux changer ta ligne de fin, débute par Commande impossible un message apparait.

Tu peux aussi lancer un mail après coup.

Edit: la variable C te donnera la ligne ou la commande est impossible. Si par hasard tu devais en avoir besoin.

A nouveau,

As tu testé le code?

Note que pour toi c'est commande impossible. Avec un c minuscule et non un C majuscule comme je l'ai inscrit dans le code.

Re

J'ai donc écrit ton code en essayant de l'adapter mais comme je maîtrise très mal la définition des références donc leur utilisation... Mais à la place du MSG box pourrais-je faire un call TestEnvoyerEmail qui est donc mon code pour envoyer un email?

Cdlt

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range, Mot As String
'Nom de l'erreur à chercher pour lancer un message et/ou mail
Mot = "commande impossible, autorisation à obtenir de Cédric ou Philippe"
Set Cel = Sheets("Feuil17(données commande 1)").Range("H94:H3000").Find(Mot, , , xlPart, xlNext)
If Not Cel Is Nothing Then C = Cel.Row: MsgBox "Autorisation nécessaire", vbCritical, "ATTENTION"
End Sub

suite,

Pourquoi commences tu en H94 alors que ta base doit normalement débuter plus bas. Non!

Mets en référence comme range ceci H2:H300

Cela fonctionnera mieux. Ta base n'est pas encore à la ligne 3000.

De plus il est préférable d'avoir un message d'alerte.

Que vas tu faire s'il y a plusieurs commandes impossibles?

Re

Je commence en H94 car les lignes supérieures n'ont pas le même code est sont difficilement modifiables car elles ont des conséquences sur d'autres onglets. C'est un fichier qui est en constant développement. Je mets H3000 car c'est un fichier annuel et l'année passée il y à eu pas loin de 3000 lignes saisies. Le message d'alerte est présent dans un msgbox lors de l'envoi email ( MsgBox "Envoi demande de validation terminé, merci d'indiquer sur la ligne le montant...") Le fichier ne peut être écrit que par un seul utilisateur à la fois.Le mesage commande impossible empêche de générer un code commande lorsque le crédit n'est pas suffisant et comme il n'y a que 6 utilisateurs la redondance sera très limitée nous pourrons agir en conséquence puisque prévenu immédiatement par mail. Je quitte le bureau mais reprend demain 8H si d'ci là tu as une solution et même des explications cela m'aide grandement à essayer de comprendre la construction du code je testerai volontiers demain matin, un grand merci de ton temps alloué.

Bonne soirée

Cdlt

Ok,

note que tu peux adapter la fin de ligne en H pas à pas dès qu'une ligne est rempli en fait.

On peut faire référence à la dernière ligne utilisée. A plus.

Bonjour zuul, Salut X Cellus,

J'ai l'impression que la valeur de H dépend de celles en E et en I, et celle en I dépendrait elle-même de la saisie en E. Donc peut-être qu'il faudrait que l'évènement change porte sur la colonne E.

Il faut juste savoir sous quelles conditions les cellules en H ont la valeur "commande impossible...".

Et si le code porte sur la feuille "données commande 1", il n'est pas nécessaire de préciser la feuille Set Cel = Range("H94:H3000").Find(Mot, , , xlPart, xlNext).

Cdlt,

Bonjour

Bon j'ai encore cherché, toujours en galère il faut surement une boucle pour répéter ce que j'arrive à faire pour une cellule,mais je suis peu compétent les erreurs de construction s'accumulent... J'ai réussi à écrire cela sans que cela ne me génère d'erreur mais cela ne me lance pas automatiquement ma macro TestEnvoyerEmail. Peut être un code du genre For i =H94 to H3000 do....? Merci de vos aides et explications pour le novices que je suis afin que je puisse grandir!

Cdlt

Sub worksheet_change(ByVal target As Range)
If target.Column = 8 Then
Set target = Range("94:3000")
End If
If target.Value = "commande impossible, autorisation à obtenir de Cédric ou Philippe" Then
 Call TestEnvoyerEmail
End If
End Sub

Pour rappel ce code fonctionne sur le fichier utilisé sur mon disque dur

Sub worksheet_change(ByVal target As Range)
Set target = Range("H94")
If target.Value = "commande impossible, autorisation à obtenir de Cédric ou Philippe" Then
 Call TestEnvoyerEmail
End If
End Sub

Bonjour Zuul, 3GB,

Pour limiter la zone de recherche, vu que ta formule cible d'abord la colonne E.

En effet si elle est vide ton message ne s'affichera jamais, selon l'image insérée dans un tes message précédents.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range, Mot As String
'Dernière case utilisée en colonne E plus prise en compte des 15 lignes antérieurs
Der = Range("E" & rows.count).End(xlup).Row
Cible = "H" & (Der - 15) & ":H" & Der
'Nom de l'erreur à chercher pour lancer un message et/ou mail
Mot = "Commande impossible"
Set Cel = Sheets("NomdetaFeuille").Range(Cible).Find(Mot, , , xlPart, xlNext)
If Not Cel Is Nothing Then C = Cel.Row: MsgBox "Autorisation nécessaire", vbCritical, "ATTENTION"
End Sub

Re,

J'ai peut-être loupé un chapitre mais j'ai l'impression qu'on a pas bien défini les conditions suivant lesquelles envoyer un message. Ce serait bien Zuul que tu les expliques verbalement, ça permettrait de réfléchir à un code approprié.

Si tu pouvais joindre un fichier exemple, en y laissant les formules, ce serait encore mieux...

Sinon, selon moi, il faudrait quelque chose comme :

Private Sub worksheet_change(ByVal target As Range)
Set r = intersect(target, columns(5))
if not r is nothing then
    for each cell in r '<<< boucle
        If application.countif(plageàdéfinir, cell.Value) = 0  Then '<<<< si le code de commande est inexistant dans une plage restant à définir
            if cells(cell.row, "H") like "commande impossible*" then Call TestEnvoyerEmail
        End If
    next cell
end if
End Sub

Cdlt,

Bonjour 3GB

Sur la capture d'écran tu pourras t'apercevoir que la condition reste un solde positif case K1 qui est le résultat d'une autre feuille. Je vais essayer de retirer la sélection de feuille car effectivement cette macro n'agirait que sur cette unique feuille. Sinon une idée pour faire une redondance de contrôle sur chaque cellule d'une même colonne. Après il est possible que je rajoute une colonne qui suivant le résultat de la colonne H indique une valeur genre 1 ou 0 et peut être un évenementiel fonctionnant en supérieur... permettrait de contrôler pour caque cellule d'une colonne ou si au moins une cellule de cette colonne est supérieure à 0 alors call TestEnvoyerEmail ?

Cdlt

ps j'ai essayé d'ôter la lecture sheet sans conséquence

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range, Mot As String
'Nom de l'erreur à chercher pour lancer un message et/ou mail
Mot = "commande impossible, autorisation à obtenir de Cédric ou Philippe"
If Not Cel Is Nothing Then C = Cel.Row: MsgBox "Autorisation nécessaire", vbCritical, "ATTENTION"
End Sub

Bonjour X Cellus

je viens de voir ton message j ai besoin de précisions Le nom de ma feuille je dois inscrire Feuil17 ou Feuil1è(données commande) ? La cible dois-je réécrire H dedans? Désolé ce sont des questions sûrement bête mais vu que j'ai des erreurs d'indice je cherche... Je ne pourrais reprendre le travail qu en fin de journée peut être à toute à l'heure

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range, Mot As String
'Dernière case utilisée en colonne E plus prise en compte des 15 lignes antérieurs
Der = Range("E" & Rows.Count).End(xlUp).Row
Cible = "H" & (Der - 15) & ":H" & Der
'Nom de l'erreur à chercher pour lancer un message et/ou mail
Mot = "Commande impossible"
Set Cel = Sheets("Feuil17").Range(Cible).Find(Mot, , , xlPart, xlNext)
If Not Cel Is Nothing Then C = Cel.Row: MsgBox "Autorisation nécessaire", vbCritical, "ATTENTION"
End Sub

A nouveau,

Reprends le code que je t'ai laissé ce matin sans rien enlever.

Mais au vu de tes nouvelles explications il serait plus simple de tester ta formule dans le code après qu'une cellule de la colonne E soit renseignée.

Et pouvoir lancer le mail.

Donc ne plus tester sur la colonne H qui peut être juste un message d'information pour l'utilisateur.