XL 2016 aide avec outlook adresse courriel

dede869

XLDnaute Occasionnel
Bonjour a tous, j"ai un userform (etape1) qui sert a entre des donné de travailleur, lorsqu'une date est entré dans la textbox5 (date du dépôt du grief au superviseur), je veux envoyer un courriel a l'adresse courriel qui est inscrit tans la textbox8, et dans la colone AA de la feuille.

Sub EnvoiAutomatiqueMail()
Dim j&
If OutlookOuvert = False Then j = Shell("Outlook", vbNormalNoFocus)
For j = 3 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(j, 5) > Now And Cells(j, 7) <> "" And Cells(j, 28) = "" Then
Envoi "Bonjour Mr, " & " " & Cells(j, 1) & "," & " " & "votre grief # " & " " & Cells(j, 2) & " " & "-" & Cells(j, 3) & "," & " a été déposé le " & " " & " " & Cells(j, 5) & "" & " a votre superviseur immédit."
Cells(j, 28) = Now
ElseIf Cells(j, 11) <> "" And Cells(j, 29) = "" Then
Envoi "Bonjour Mr, " & " " & Cells(j, 1) & "," & " " & "votre grief # " & " " & Cells(j, 2) & " " & "-" & Cells(j, 3) & "," & " a été déposé le " & " " & " " & Cells(j, 11) & "" & " au surintendant."
Cells(j, 29) = Now
ElseIf Cells(j, 15) <> "" And Cells(j, 30) = "" Then
Envoi "Bonjour Mr, " & " " & Cells(j, 1) & "," & " " & "votre grief # " & " " & Cells(j, 2) & " " & "-" & Cells(j, 3) & "," & " a été déposé le " & " " & " " & Cells(j, 15) & "" & " au Resource Humaine."
Cells(j, 30) = Now
ElseIf Cells(j, 19) <> "" And Cells(j, 31) = "" Then
Envoi "Bonjour Mr, " & " " & Cells(j, 1) & "," & " " & " une demande d'arbitrage a été demandé le" & " " & Cells(j, 18) & " " & "pour votre grief # " & " " & Cells(j, 2) & " " & "-" & Cells(j, 3)
Cells(j, 31) = Now
End If
Next j
End Sub
Function Envoi(Corps$)
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMail
.Subject = "Dépôt de grief avant date d'échéance"
.To = Feuil2.[aa3]
.CC = Feuil2.[am3]
.Body = Corps
.Display 'pour voir
'.Send 'pour envoyer
End With
End Function
Function OutlookOuvert() As Boolean
Dim oOL As Object
On Error Resume Next
Set oOL = GetObject(, "Outlook.Application")
On Error GoTo 0
OutlookOuvert = Not (oOL Is Nothing)
Set oOL = Nothing
End Function

Merci de votre aide
 

Pièces jointes

  • Tableau des grief 2016.xlsm
    117.6 KB · Affichages: 55

dede869

XLDnaute Occasionnel
non c'est pas ça la problème, c'est que le fichier sera utilisé par plusieurs personne, et je ne veut pas qu'il modifie les formule qui sont dans les colonnes protégé donc il faut un mot de passe pour bloquer la possibilité enlevé la protection. Mais lorsqu'il entre des donné via les formulaire la protection doit s'enlevé et se remettre immédiatement après sans mot de passe.

merci
 

dede869

XLDnaute Occasionnel
Oublie tout ça, j'ai trouver le problème, lorsque j'avais le code qui suit étais dans "Private Sub b_validation_Click_Click()" pour l'enregistrement, c'est a cause de lui que j'étais obliger d'enlevé la protection pour sauvegarder les donné. Une fois enlevé je peut protégé avec un mot de passe et pas besoin de l'enlevé en utilisant les formulaire.

lig = ActiveCell.Row
For col = 5 To 11
If Cells(lig, col).Value = 0 Then Cells(lig, col).Clear
Next col

Merci de ton aide.
 

dede869

XLDnaute Occasionnel
Bonjour Lone-wolf,

Y a t'il un moyen pour bloquer la fonction d'un commanbutton s'il clic sur le mauvais. exemple lorsque j'entre des donné pour la première fois dans l'étape 1 et au lieu de cliquer sur "enregistrer" je clic sur "modifier" ça crée un blocage.

Merci
 

dede869

XLDnaute Occasionnel
Bonjour love-wolf,

Je doit modifier ma recherche (consultation) dans mes toute mes étape s, car dans mon tableau il y a dess noms dans la colonne A et des numéro dans la colonne B. Il se peut que dans la colonne A un nom peut se répété mais pas avec le même numéro. Donc je doit rajouter 2 combobox, un pour les nom (combobox1) et l'autre les numéro (combobox2)se rapportant au nom de la combobox1. et changer la combobox qui étais relier au Grief en textbox.

je te renvoie le même fichier qu'au début qui n'a pas .t. modifier (car le nouveau fichier est trop lord) avec l'étape 1 modifier avec ce que j'ai besoin.
 

Pièces jointes

  • Tableau des grief 2016 (8).xlsm
    81.4 KB · Affichages: 30

dede869

XLDnaute Occasionnel
Bonjour Love-wolf,

J'ai trouver ceci, mais il cache les ligne donc les information ne sont pas relier a la combobox2. Comment faire pour qu'il ne cache pas les donné cor lorsque je veut consulté un message qu'il n'existe pas dans la liste.

Merci

Dim i As Byte, k As Byte
Dim Fait As Boolean, Fait2 As Boolean
Dim Derligne As Integer, Li As Integer
Dim Cel As Range


Private Sub UserForm_Initialize()
Sheets("TABLEAU").Activate
With Sheets("TABLEAU")
Derligne = .UsedRange.Rows.Count
.Range("A3:A" & Derligne).EntireRow.Hidden = False
Set mondico = CreateObject("Scripting.Dictionary")
For Each Cel In Range("A3:A" & Derligne)
mondico.Item(Cel.Value) = Cel.Value
Next Cel
Tmp = mondico.items
Me.ComboBox2.List = Tmp
End With
Set mondico = Nothing
End Sub

Private Sub ComboBox2_Change()
With Sheets("TABLEAU")
.Range("A3:A" & ActiveSheet.UsedRange.Rows.Count).EntireRow.Hidden = False
Set mondico = CreateObject("Scripting.Dictionary")
For Each Cel In Range("B3:C" & Derligne)
If Cel.Offset(0, -1) Like ComboBox2.Value Then
If Not mondico.Exists(Cel.Value) Then mondico.Add Cel.Value, Cel.Value
End If
Next
Tmp = mondico.items
'Call tri(Tmp, LBound(Tmp), UBound(Tmp))
ComboBox4.List = Tmp
'Application.ScreenUpdating = False
For Li = 3 To Derligne
If Cells(Li, 1).Value <> ComboBox2.Value Then Cells(Li, 1).EntireRow.Hidden = True
Next
'Application.ScreenUpdating = True
End With
Set mondico = Nothing
End Sub

Private Sub ComboBox4_Change()
'Application.ScreenUpdating = False
With Sheets("TABLEAU")
.Range("A2:A" & ActiveSheet.UsedRange.Rows.Count).EntireRow.Hidden = False
For Li = 3 To Derligne
If CStr(Cells(Li, 1).Value) <> ComboBox2.Value Then Rows(Li).Hidden = True
If Cells(Li, 2).Value <> ComboBox4.Value Then Rows(Li).Hidden = True
Next
'Application.ScreenUpdating = True
End With
End Sub
 

Pièces jointes

  • Tableau des grief 2016 (8).xlsm
    92.7 KB · Affichages: 32

dede869

XLDnaute Occasionnel
Bonjour Love-wolf,

Tous fonctionne très bien merci de ton aide, j'ai un autre projet, j'ai un tableau avec des noms de unité dans les colonne C-D-E et dans les lignes 3 a 13 c'est pour le mois de janvier et ainssi de suite pour tous les mois,

Je diot entré des donnés a chaque mois et pour chaque unité j'ai préparer un userform pour la saisie des donné, comment faire pour qu'il entre a la bonne place.

Merci
 

Pièces jointes

  • Classeur1.xlsm
    338.6 KB · Affichages: 30

Discussions similaires

Réponses
14
Affichages
621

Statistiques des forums

Discussions
311 737
Messages
2 082 030
Membres
101 876
dernier inscrit
JULIEN21370