Lancer une macro en fonction d'un texte dans une cellule mais pour colonne
Re 3GB
J'ai tenté de coller ton code mais pour la plage à définir je dois mal m'y prendre...Le but de la formule sous excel colonne H est d'empêcher de générer un numéro de en colonne E si le budget restant ne le permet pas (K1). Apparît donc un texte commande impossible.... en colonne H . Donc lorsqu'aapparaît ce message je génére automatiquement un email de demande validation et un msgbox préviens l'utilisateur qu'une demande à été initiée
Cdlt
Private Sub worksheet_change(ByVal target As Range)
Set r = Intersect(target, Columns(8))
If Not r Is Nothing Then
For Each cell In r '<<< boucle
If Application.CountIf(H94:H3000, cell.Value) = 0 Then
If Cells(cell.Row, "H") Like "commande impossible, autorisation à obtenir de Cédric ou Philippe" Then Call TestEnvoyerEmail
End If
Next cell
End If
End Sub
Bonsoir Zuul,
Ton souci ne vient pas du nom de la feuille. Puisque tu as installé le code dans cette feuille et non dans un module. Tu n'as pas besoin de faire référence à son nom.
Tu as simplement inscrit Commande avec un C majuscule alors que ton message d'erreur commence par commande avec un c minuscule.
Fai attention à ce que tu écris... Et/ou vérifie plusieurs fois. Ce sont des fautes d'inattention qui te font faire des blocages.
Bonsoir à tous,
Sur la ligne bloquante, il faut aussi mettre range("H94:H3000"). Mais attention, ce test, avec le countif, suppose qu'on envoie le mail si le numéro en colonne E n'existe pas dans une plage recensant les numéros de commande. J'ai fait cette supposition car en fait je ne sais rien de ce que tu cherches à faire et ça me semblait logique.
Donc je le répète, si ton envie est de résoudre ton problème, il faudrait que tu l'exprimes clairement ou que tu joignes un fichier exemple.
Par ailleurs, dans le dernier code que j'ai posté, il faut mettre intersect(target, columns(5)) et ça m'étonne que la colonne E dépende de la colonne H étant donné que la colonne H dépend directement de la colonne E (il y aurait donc circularité).
Maintenant, voici comme je comprends la chose : on saisit des numéros qui permettent de passer commande automatiquement ou d'alimenter une liste de commandes à passer. A force de saisir, le solde en K1 est diminué des montants correspondants à ces commandes. Dès que K1 devient négatif, il faut bloquer les commandes.
De mon point de vue, envoyer un mail sans demande de confirmation me parait déjà un peu exagéré, surtout avec une procédure change. Peut-être qu'il faudrait utiliser la procédure change pour remplacer la formule en H, en couplant l'opération avec une MFC afin de mettre en évidence ces lignes. On pourrait par ailleurs prévoir une macro, avec un bouton, pour envoyer un mail répertoriant toutes les commandes en attente de validation.
private sub worksheet_change(byval target as range)
set r = intersect(target, columns(5)) 'plage sur laquelle a lieu le chgt
if not r is nothing then 'si elle n'est pas vide
if range("K1").value <= 0 then 'si K1 négatif (<<< devrait même etre : si K1 < montant commande !!!)
for each cell in r 'pour chaque cellule de la plage
cells(cell.row, "H").value = "Commande impossible..." 'on inscrit commande impossible en H
next cell
end if
end sub
Sub LancerAlerte()
dim t(), strbody$
with activesheet
dl = .cells(.rows.count, "H").end(xlup).row 'derniere ligne en H
for i = 94 to dl 'ligne 94 à derniere
if .cells(i, "H").value like "Commande impossible*" then 'si H contient commande impossible
n = n + 1 'incrémentation n
redim preserve t(1 to n) 'redimension tableau listant commandes en attente
t(n) = .Cells(i, "E").value & "-" & '.cells(i, "G").value 'nouvel item = concaténation E et G
end if
next i
end with
Commandesbloquees = join(t(n), chr(10)) 'on joint les valeurs du tableau (en les séparant d'un retour à la ligne)
strbody = "Bonjour," & chr(10) & chr(10) _
& "Voici la liste des commandes en attente de validation :" & chr(10) _
& Commandesbloques & chr(10) & chr(10) _
& "Cordialement,"
EnvoyerMail "Validation Achat", "mme.mr@contact.fr", strbody 'on exécute la macro d'envoi de mail qui dépend de cette liste (rentrée en paramètre)
end subCdlt,
Voici un code pour le mail en version simplifiée :
Sub EnvoyerEmail(ByVal Sujet As String, ByVal Destinataire As String, ByVal Contenu As Variant, Optional ByVal PieceJointe As String)
On Error GoTo EnvoyerEmailErreur
Dim oOutlook As Outlook.Application
Dim oMailItem As Outlook.MailItem
PreparerOutlook oOutlook
Set oMailItem = oOutlook.CreateItem(0)
'création de l'email
With oMailItem
.To = Destinataire
'.CC = "XXXXXXXXXXXXXXXX"
.Subject = Sujet
.Body = Contenu
If PieceJointe <> "" Then .Attachments.Add PieceJointe
End With
Set oMailItem = Nothing
Set oOutlook = Nothing
EnvoyerEmailErreur:
MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"
End SubCdlt,
Bonjour 3GB
Je prends note de tes remarques et t'en remercie. Le champs de la colonne (E) est saisi manuellement par exempla cma/2103 correspondant aux initiales utilisateur année mois
Cette saisie vient se compléter en automatique par un numéro qui s'incrémente par rapport à la ligne précédente chronologiquement exemple précédente commande cma/2103-050 suivante cma/2103-051
Afin de maîtriser le budget, il à été décidé de contenir l'engagé mensuel afin de mieux répartir les dépenses non essentielles et prioriser celles nécessaires lorsque le budget qui est variable en fonction des ventes, s'amenuise
Les utilisateurs sont informés et ont accès au budget restant donc si ils initient une commande, ils savent aussi le montant qu'ils ont à dépensés et comparent d'un coup d’œil si ça passent ou le cas échéant si ils ne vérifient pas cela auront ce message "commande....
Je te rejoins sur la comparaison avec somme de dépenses sachant que le montant est inscrit en colonne AF est-ce que cette modification que je propose est correcte pour la syntaxe ainsi que la comparaison si j'ai bien compris : si la valeur de la plage K1 est plus petite que la valeur en AF de la dernière ligne
donc de
If Range("K1").Value <= 0 Then 'si K1 négatif (<<< devrait même etre : si K1 < montant commande !!!)peut être mais je doute fortement de la bonne syntaxe
If Range("K1").Value >= Range("dl,AF").Value Then 'si K1 négatif (<<< devrait même etre : si K1 < montant commande !!!)Sur le code que tu m'as donné il manquait un End if j'espère l'avoir placé correctement à la 8ème ligne. J'ai par contre une erreur de syntaxe (corrigée) dans cette ligne
t(n) = .Cells(i, "E").value & "-" & '.cells(i, "G").value 'nouvel item = concaténation E et GJe comprends que celle-ci sert à identifier les numéros de commande à lister dans un tableau. J'ai remarqué qu'il manquait le C en majuscule devant (i, donc je l'ai corrigé..
Ensuite une erreur d'expression est apparue, l'apostrophe devant cells de cette même ligne que j'ai supprimé mais je doute si nouvel item=concaténer... est un commentaire de ta part ou une fonction pour associer les éléments constituant le numéro de commande?
Pour finir la macro qui inscit commande impossible...fonctionne bien mais lorsque je veux permettre l'écriture de celle-ci car par exemple j'inscris "validé" dans la colonne I et bien la concaténation à disparu puisque la macro m’efface ma condition.il faut la tirer du dessus
=SI(E93="";"";SI(ET($K$1<0;I93="");"commande impossible, autorisation à obtenir de Cédric ou Philippe";+CONCATENER(E93;F93;G93)))
Depuis ce matin je retourne un peu dans tous les sens le code je persévère et continues en espérant trouver une solution et je n'arrive pas à comprendre le bloquage de la ligne Commandesbloquees peut être faut-il déclarer en variables avant? J'oubliais j'ai modifié l'orthographe en Commandesbloquees également je pense que ces fautes sont là pour m'aider à réflechir et c'est tant mieux cela m'apprend à être plus rigoureux
Merci en tout cas des gros efforts que vous fournissez à la résolution...
Cdlt
Private Sub worksheet_change(ByVal target As Range)
Set r = Intersect(target, Columns(5)) 'plage sur laquelle a lieu le chgt
If Not r Is Nothing Then 'si elle n'est pas vide
If Range("K1").Value <= 0 Then 'si K1 négatif (<<< devrait même etre : si K1 < montant commande !!!)
For Each cell In r 'pour chaque cellule de la plage
Cells(cell.Row, "H").Value = "commande impossible, autorisation à obtenir de Cédric ou Philippe" 'on inscrit commande impossible en H
Next cell
End If
End If
End Sub
Sub LancerAlerte()
Dim t(), strbody$
With ActiveSheet
dl = .Cells(.Rows.Count, "H").End(xlUp).Row 'derniere ligne en H
For i = 94 To dl 'ligne 94 à derniere
If .Cells(i, "H").Value Like "commande impossible, autorisation à obtenir de Cédric ou Philippe*" Then 'si H contient commande impossible
n = n + 1 'incrémentation n
ReDim Preserve t(1 To n) 'redimension tableau listant commandes en attente
t(n) = .Cells(i, "E").value & "-" & '.cells(i, "G").value 'nouvel item = concaténation E et G
End If
Next i
End With
Commandesbloquees = Join(t(n), Chr(10)) 'on joint les valeurs du tableau (en les séparant d'un retour à la ligne)
strbody = "Bonjour," & Chr(10) & Chr(10) _
& "Voici la liste des commandes en attente de validation :" & Chr(10) _
& Commandesbloques & Chr(10) & Chr(10) _
& "Cordialement,"
EnvoyerMail "Validation Achat", "mme.mr@contact.fr", strbody 'on exécute la macro d'envoi de mail qui dépend de cette liste (rentrée en paramètre)
End SubRe Messieurs
Au final je fais différemment comme conseillé au début de ce poste
Je rajoute un bouton d'envoi d'email avec un msgbox signifiant de bien remplir le montant et ou il faut double-cliquer pour envoyer l'email de demande validation Mais j'aurai aimé générer ce msgbox dès lors qu'apparaît le texte "commande impossible, autorisation à obtenir de Cédric ou Philippe" pour guider l'utilisateur à renseigner montant et double cliquer sur le bouton macro :
MsgBox "La demande de validation a bien été envoyée et sera traitée en comité de validation.Il est impératif de remplir le montant des dépenses pour que celle-ci soit traitée.En cas de nécessité urgente contacter Cédric ou Philippe"
Je corrige la formule en H pour qu'elle compare solde restant en K1 avec AF( la dépense voulue). Il faut juste que je trouve comment rajouter dans mes conditions en ET des cellules colonne H, que dans la colonne AF soit <>"" pour aussi impliquer les utilisateurs à renseigner une valeur puisque je compare K1 et AF pour générer le bloquage de l'affichage du numéro de commande
Je souhaiterais également permettre la génération du numéro de commande dans le cas d'une demande de devis. Cette information "devis" est présente en liste déroulante colonne Q
En tout cas très content d'avoir conversé avec vous car j'ai appris pas mal même si encore beaucoup d'inconnus dans vos codes pour moi encore merci
Bonjour Zuul,
Ca fait beaucoup d'éléments à intégrer...
Désolé pour les petites coquilles, il n'y avait aucune intention pédagogique, j'ai écrit le code tard directement sur le site et n'ai pas assez contrôlé (malgré quelques petites modifs).
Pour répondre à ta question sur la syntaxe, il faudrait plutôt ceci :
If Range("K1").Value <= Range("AF" & dl).Value Then 'si K1 < montant commandeJe dois avouer que je suis un peu perdu. Ce serait plus simple avec le code, et un descriptif clair et concis des blocages persistants. Si tu exprimes les conditions clairement, ce sera plus simple de les traduire en code.
En tout cas, cette formule :
=SI(E93="";"";SI(ET($K$1<0;I93="");"commande impossible, autorisation à obtenir de Cédric ou Philippe";+CONCATENER(E93;F93;G93)))equivaut à :
Private Sub worksheet_change(ByVal target As Range)
Set r = Intersect(target, Columns(5)) 'plage sur laquelle a lieu le chgt
If Not r Is Nothing Then 'si elle n'est pas vide
For Each cell In r 'pour chaque cellule de la plage
if cell.value = "" then
cells(cell.row, "H").value = ""
elseif Range("K1").Value < 0 and cells(cell.row, "I").value = "" Then
cells(cell.row, "H").value = "commande impossible, autorisation à obtenir de Cédric ou Philippe"
else
cells(cell.row, "H").value = cell.value & cells(cell.row, "F").value & cells(cell.row, "G").value
end if
Next cell
End If
End If
End SubCdlt,
Bonsoir 3GB
Je vais essayer ton code demain pour essayer de dechiffrer et comprendre la manipulation des cells.Mon gros problème je pense est de comprendre comment faire une boucle et donc soit d incrémenter une variable ou soit si je comprends bien, utiliser for each qui regarde chaque intersection en colonne E et en fin de code passe par next celle donc saute a l intersection suivante donc ligne en dessous . En fait j explique un peu ce que je crois comprendre car j' ai l intention d essayer de déclencher un msgbox a chaque fois qu apparaît dans la colonne H le texte " commande impossible..."
bonne soiree
Re,
Il faut que tu poses le problème sur papier avant d'écrire le code dans l'éditeur, ce n'est jamais facile quand on a pas l'habitude.
Au cas où, pour lever une éventuelle confusion, le for each cell in r signifie pour chaque cellule de la plage r. La boucle permet de parcourir l'union des cellules (les unes après les autres) mais c'est valable dans bien des cas et pas qu'avec des cellules (c'est une boucle sur une collection). Il est courant de boucler sur l'ensemble des feuilles par exemple.
Il se trouve que dans le cas précis, r est l'intersection entre la colonne E et la zone ayant subi un changement (via une saisie ou équivalent, mais pas suite à un calcul). C'est donc la zone du changement (la target) limitée aux cellules en colonne E. La plupart du temps, voire à chaque fois, il n'y aura qu'une cellule modifiée en E (donc pas vraiment de boucle). C'est juste une sécurité et une façon de rendre le code valable même avec une multi-modification.
Cdlt,
Bonjour 3GB
J'ai essayé ton code et c'est intéressant pour ma compréhension
il fonctionne presque...
Premier point :
Le problème est que lorsque l'on initie un code mais que le budget ne le permet pas nous avons effectivement le blocage et donc le message "commande... qui apparait jusque la très bien; cependant pour validé celui-ci en colonne I et donc récupérer l'affichage du code commande il faut l'écrire avant de taper le code sinon ce dernier ne permet pas d'effacer le message "commande... et adonc afficher le code .
Donc en plus clair si j'écris "validé" en colonne I avant de taper mon code en colonne G et ce malgré un budget insuffisant cela fonctionne
Si j'écris "validé" en colonne I après avoir tapé mon code en colonne G et ce malgré un budget insuffisant cela ne fonctionne pas
Etant donné que le texte dans la colonne I "validé" sera remplit après la demande initiée donc celui-ci ne débloque pas le code commande en H
Deuxième point :
La partie qui concatène le code ne fonctionne pas du coup si on est dans le cas ci-dessus, à savoir, texte validé écris aprés la demande du codecelle-ci n'affiche pas le code commande
Cells(cell.Row, "H").Value = cell.Value & Cells(cell.Row, "F").Value & Cells(cell.Row, "G").Value
Cordialement
PS
J'ai essayé la petite modif pour comparer K1 avec le montant commande plutôt que <0 mais ça plante?
Private Sub worksheet_change(ByVal target As Range)
Set r = Intersect(target, Columns(5)) 'plage sur laquelle a lieu le chgt
If Not r Is Nothing Then 'si elle n'est pas vide
For Each cell In r 'pour chaque cellule de la plage
If cell.Value = "" Then
Cells(cell.Row, "H").Value = ""
ElseIf Range("K1").Value <= Range("AF" & dl).Value And Cells(cell.Row, "I").Value = "" Then
Cells(cell.Row, "H").Value = "commande impossible, autorisation à obtenir de Cédric ou Philippe"
Else
Cells(cell.Row, "H").Value = cell.Value & Cells(cell.Row, "F").Value & Cells(cell.Row, "G").Value
End If
Next cell
End If
End SubBonjour Zuul,
Ca m'étonne que la concaténation ne fonctionne pas correctement...
Pour le plantage, c'est parce que la variable dl n'est pas initialisée.
Mais de toute façon, je pense qu'il vaut mieux rester sur une solution avec un bouton pour le moment, tant que toutes les conditions ne sont pas parfaitement définies.
Cdlt,
re
J'ai une question pour avancer encore. Pour tout précedemment cela fonctionne comme voulu avec quelques corrections j ai aussi ajouter une macro pour une mise à jour automatique de mon TCD te j'ai d'ailleurs compris que si plusieurs sheets possedent un TCD issu de la même base de données il faut dans la feuille de travail de la base de données justement ne pas répéter la première ligne private.... voir code ci-dessous
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
Sheets("cma_pml").PivotTables("TCD").RefreshTable
Application.EnableEvents = True
Application.EnableEvents = False
Sheets("avril 21").PivotTables("TCD2").RefreshTable
Application.EnableEvents = True
Application.EnableEvents = False
Sheets("mars 21").PivotTables("TCD0").RefreshTable
Application.EnableEvents = True
End SubAfin de pouvoir utiliser une commande spécifique sur des fichiers excel et utiliser des macros
Comment est-il possible de générer l'envoi de mails par le biais d'n bouton double clique (ça je sais faire) mais en associant des items comme par exemple numéro de commande soit en copiant collant dans une cellule prévue à cet effet et aussi en choisissant une adresse mail de destinataire qui serait soit dans une liste déroulante de cellule (validation de données/liste) ou au pire en copiant collant dans une cellule dédiée? Je ne sais pas si je suis assez claire Par exemple
Sachant que j'ai un code TestenvoyerEmail qui fonctionne parfaitement et me plait de part sa possibilité d'ouverture d'outlook si il est fermé ainsi que les msgbox ,mais il n'est pas épuré j'ai peur qu'il ne fonctionne plus si je modifie et je n'ai pas réussi à faire fonctionner celui proposé dans ce post
Bonjour Zuul,
Tu es prolixe !
Pour le mail, ta macro dépend de paramètres. Il faut l'exécuter à partir d'une autre macro en entrant les bonnes valeurs en arguments :
G1 : Sujet
R1 : Objet
S1 : Destinataire
Exemple :
Sub LancerAlerte()
'début du code
Call EnvoyerMail(range("G1").value, Range("R1").value, Range("S1").value)
end subBien sûr, il faut respecter l'ordre des paramètres.
Ce petit code sert d'exemple et se base sur celui que j'ai proposé plus bas. Il faudra peut-être adapter...
Sinon, il est toujours possible d'enlever les paramètres et les rentrer en dur dans le code (mais en général, c'est moins bien).
Cdlt,
Bonjour 3GB
Me revoilà!
Je vois que tu es aussi analyste comportemental car effectivement j'ai consulté la définition de prolixe c'est tout à fais cela. Peur d'oublier un détail que j'en raconterai ma vie mdr
J'avance encore sur la construction ou du moins la modification de mon fichier commande
J'ai une question qui je pense être difficile à résoudre mais je vais essayer de poser correctement en texte puis en copie d'écran et avec le code que j'ai mis
Donc je souhaite créer un numéro aléatoire compris entre 64 et 2064 en colonne G qui sera générer automatiquement suivant les conditions suivantes
=SI(ET(E104<>"";I104<>"");TIRAGESELEC(2064);SI(ET(E104<>"";H104<>"commande impossible, autorisation à obtenir de Cédric ou Philippe sauf si devis");TIRAGESELEC(2064);""))Cette formule sera donc effective de la ligne 103 à au moins 2067
Première question : TIRAGESELEC est une fonction (voir ci-dessous Module 3) donc qui fonctionne parfaitement cependant j'aimerais que lorsqu'elle a généré un nombre, celui-ci soit figé et ne change plus en automatique même si on génère des numéros sur les lignes suivantes il doit resté figé et sa valeur doit être prise en compte pour ne pas créer de doublons
Deuxième question : Je voudrais également avoir la possibilité de malgré tout pouvoir copier coller ce numéro car sur une commande il peut y avoir plusieurs donc plusieurs fois par exemple le 064 dans la même colonne donc G64, G65,G66...
Le Module 2 fonctionne mais le Module 3 je réfléchis encore donc sûrement pas correct...Pour les capture d'écran en second temps car j'écris trop ça passe pas!
Function TIRAGESELEC(n As Integer)
Dim tabt(), tablo() As Integer, i%, m%, x%
Application.Volatile False
If n < 1 Then
TIRAGESELEC = CVErr(xlErrNum)
Exit Function
End If
m = ActiveCell.Row
ReDim tabt(1 To m)
If m > n Then
For i = n + 1 To m
tabt(i) = CVErr(xlErrNA)
Next i
m = n
End If
ReDim tablo(n)
For i = 1 To n
tablo(i) = i
Next i
Randomize
For i = 1 To n
x = Int(64 * Rnd + 1)
tablo(0) = tablo(x)
tablo(x) = tablo(i)
tablo(i) = tablo(0)
Next i
tablo(0) = tablo(n)
x = Int(n * Rnd + 1)
For i = 1 To m
tabt(i) = tablo((x - 1 + i) Mod n)
Next i
If Application.Caller.Rows.Count > 1 Then
TIRAGESELEC = Application.Transpose(tabt)
Else
TIRAGESELEC = tabt
End If
End FunctionLà c'est le code de ma feuille si besoin
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("Q1")) Is Nothing Then
Call TestEnvoyeEmailRetour(Range("G1").Value, Range("R1").Value, Range("S1").Value)
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
Sheets("cma_pml").PivotTables("TCD").RefreshTable
Application.EnableEvents = True
Application.EnableEvents = False
Sheets("avril 21").PivotTables("TCD2").RefreshTable
Application.EnableEvents = True
Application.EnableEvents = False
Sheets("mars 21").PivotTables("TCD0").RefreshTable
Application.EnableEvents = True
End SubModule 1
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 = "c.m@c.fr"
.CC = ""
.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)
'
'------------------------------------------------------------------------------------------------
'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 d'achat a été initiée.<br>Cordialement.<br>"")
'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 "La demande de validation a bien été envoyée et sera traitée en comité de validation.Il est impératifde remplir le montant des dépenses pour que celle-ci soit traitée sous 48H.En cas de nécessité urgente contacter Cédric ou Philippe"
End Sub
Sub TestEnvoyerEmailRetour()
'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>test test test.<br>"")
'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 "test test test tif"
End SubModule 2
Sub TestEnvoyeEmailRetour(ByVal Sujet As String, ByVal Destinataire As String, ByVal Contenu As Variant, Optional ByVal PieceJointe As String)
On Error GoTo EnvoyerEmailErreur
Dim oOutlook As Outlook.Application
Dim oMailItem As Outlook.MailItem
PreparerOutlook oOutlook
Set oMailItem = oOutlook.CreateItem(0)
'création de l'email
With oMailItem
.To = Range("S1").Value
'.CC = "c.m@crfr"
.Sujet = Range("R1").Value
.Body = Contenu
If PieceJointe <> "" Then .Attachments.Add PieceJointe
End With
Set oMailItem = Nothing
Set oOutlook = Nothing
EnvoyerEmailErreur:
MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"
End Sub
Module 3
<pre>Function TIRAGESELEC(n As Integer)
Dim tabt(), tablo() As Integer, i%, m%, x%
Application.Volatile False
If n < 1 Then
TIRAGESELEC = CVErr(xlErrNum)
Exit Function
End If
m = ActiveCell.Row
ReDim tabt(1 To m)
If m > n Then
For i = n + 1 To m
tabt(i) = CVErr(xlErrNA)
Next i
m = n
End If
ReDim tablo(n)
For i = 1 To n
tablo(i) = i
Next i
Randomize
For i = 1 To n
x = Int(64 * Rnd + 1)
tablo(0) = tablo(x)
tablo(x) = tablo(i)
tablo(i) = tablo(0)
Next i
tablo(0) = tablo(n)
x = Int(n * Rnd + 1)
For i = 1 To m
tabt(i) = tablo((x - 1 + i) Mod n)
Next i
If Application.Caller.Rows.Count > 1 Then
TIRAGESELEC = Application.Transpose(tabt)
Else
TIRAGESELEC = tabt
End If
End Function
</pre><br>Merci d'avance de l'aide précieuse apportée
Bonjour à tous
N'ayant pas de retour su ce post peut-être faut-il que j'en crée un nouveau puisque c'est une dérive de la demande initiale mais sur l même fichier?
A vous lire
Salut Zuul,
Oui, je pense... On dérive un peu et il faut essayer de rendre tes demandes digestes si tu veux obtenir des réponses parce que quand je vois un commentaire avec des dizaines de lignes d'explication ou des centaines de lignes de code
Cdlt,