XL 2019 assemblage 2 petits code vba message erreur

David62800

XLDnaute Nouveau
bonjour
j ai un souci pour assembler 2 codes vba trouver sur le fil et avec l'aide vos lumières

ce code fonctionne mais la sélection a envoyer n'est pas la bonne(voir second code)
Sub envoyermailorigine()
Dim Mafeuille As Worksheet
Dim NbLigne As Long
Dim Plage As Range
ActiveWorkbook.EnvelopeVisible = True
Set Mafeuille = ThisWorkbook.Sheets("Dashboard")
Application.ScreenUpdating = False
NbLigne = 3267
NbLigne = Mafeuille.Range("A" & Application.Rows.Count).End(xlUp).Row
Set Plage = Range("A1:M" & NbLigne)
With Range("A1:M" & NbLigne).Parent.MailEnvelope.Item
.To = Mafeuille.Range("Z3").Value & Mafeuille.Range("Z4").Value
.Subject = Mafeuille.Range("Z5").Value
.Display
.send
End With
MsgBox "votre mail a été envoyé", vbInformation + vbOKOnly, "confirmation d'envoi"

Application.ScreenUpdating = True
End Sub

second code:ce code pour sélectionner les lignes demandées fonctionne mais il faut le coupler a celle pour envoyer le mail juste en haut
Dim Mafeuille As Worksheet, NbLigne%, Plage As Range
NbLigne = Sheets("Dashboard").Application.CountIf([Tableau2[PROJETS]], "><")
Set Plage = Sheets("Dashboard").Range("A3:M" & NbLigne + 4)
Plage.Select


j'ai essayé plusieurs solutions mais mon niveau n'est pas assez bon
merci le fil
 

Pièces jointes

  • Copie de testok.xlsm
    32.5 KB · Affichages: 3

Gégé-45550

XLDnaute Accro
bonjour
j ai un souci pour assembler 2 codes vba trouver sur le fil et avec l'aide vos lumières

ce code fonctionne mais la sélection a envoyer n'est pas la bonne(voir second code)
Sub envoyermailorigine()
Dim Mafeuille As Worksheet
Dim NbLigne As Long
Dim Plage As Range
ActiveWorkbook.EnvelopeVisible = True
Set Mafeuille = ThisWorkbook.Sheets("Dashboard")
Application.ScreenUpdating = False
NbLigne = 3267
NbLigne = Mafeuille.Range("A" & Application.Rows.Count).End(xlUp).Row
Set Plage = Range("A1:M" & NbLigne)
With Range("A1:M" & NbLigne).Parent.MailEnvelope.Item
.To = Mafeuille.Range("Z3").Value & Mafeuille.Range("Z4").Value
.Subject = Mafeuille.Range("Z5").Value
.Display
.send
End With
MsgBox "votre mail a été envoyé", vbInformation + vbOKOnly, "confirmation d'envoi"

Application.ScreenUpdating = True
End Sub

second code:ce code pour sélectionner les lignes demandées fonctionne mais il faut le coupler a celle pour envoyer le mail juste en haut
Dim Mafeuille As Worksheet, NbLigne%, Plage As Range
NbLigne = Sheets("Dashboard").Application.CountIf([Tableau2[PROJETS]], "><")
Set Plage = Sheets("Dashboard").Range("A3:M" & NbLigne + 4)
Plage.Select


j'ai essayé plusieurs solutions mais mon niveau n'est pas assez bon
merci le fil
Bonsoir,
À tester.
VB:
Sub envoyermailorigine()
Dim Mafeuille As Worksheet
Dim NbLigne As Long
Dim Plage As Range
ActiveWorkbook.EnvelopeVisible = True
Set Mafeuille = ThisWorkbook.Sheets("Dashboard")
Application.ScreenUpdating = False
NbLigne = Mafeuille.Application.CountIf([Tableau2[PROJETS]], "><")
Set Plage = mafeuilleRange("A4:M" & NbLigne + 4)
Plage.Select
With Range("A1:M" & NbLigne).Parent.MailEnvelope.Item
    .To = Mafeuille.Range("Z3").Value & Mafeuille.Range("Z4").Value
    .Subject = Mafeuille.Range("Z5").Value
    .body = Mafeuille.Range("Z6").Value
    .Display
    .send
End With
MsgBox "votre mail a été envoyé", vbInformation + vbOKOnly, "confirmation d'envoi"

Application.ScreenUpdating = True
End Sub
Cordialement,
 
Dernière édition:

David62800

XLDnaute Nouveau
Bonsoir,
À tester.
VB:
Sub envoyermailorigine()
Dim Mafeuille As Worksheet
Dim NbLigne As Long
Dim Plage As Range
ActiveWorkbook.EnvelopeVisible = True
Set Mafeuille = ThisWorkbook.Sheets("Dashboard")
Application.ScreenUpdating = False
NbLigne = Mafeuille.Application.CountIf([Tableau2[PROJETS]], "><")
Set Plage = mafeuilleRange("A4:M" & NbLigne + 4)
With Range("A1:M" & NbLigne).Parent.MailEnvelope.Item
    Plage.Select
    .To = Mafeuille.Range("Z3").Value & Mafeuille.Range("Z4").Value
    .Subject = Mafeuille.Range("Z5").Value
    .Display
    .send
End With
MsgBox "votre mail a été envoyé", vbInformation + vbOKOnly, "confirmation d'envoi"

Application.ScreenUpdating = True
End Sub
Cordialement,
merci Gégé
a force de bidouiller je venez juste de trouver

Sub selection_fonctionne_ok()
Dim Mafeuille As Worksheet, NbLigne%, Plage As Range
NbLigne = Sheets("Dashboard").Application.CountIf([Tableau2[PROJETS]], "><")
Set Plage = Sheets("Dashboard").Range("A3:M" & NbLigne + 4)
Plage.Select
End Sub
Sub envoyermailorigine()
Application.ScreenUpdating = False
Dim Mafeuille As Worksheet, NbLigne%, Plage As Range
NbLigne = Sheets("Dashboard").Application.CountIf([Tableau2[PROJETS]], "><")
Set Plage = Sheets("Dashboard").Range("A3:M" & NbLigne + 4)
Plage.Select
ActiveWorkbook.EnvelopeVisible = True
Set Mafeuille = ThisWorkbook.Sheets("Dashboard")

With Range("A1:M" & NbLigne).Parent.MailEnvelope.Item
.To = Mafeuille.Range("Z3").Value & Mafeuille.Range("Z4").Value
.Subject = Mafeuille.Range("Z5").Value
.body = Mafeuille.Range("Z6").Value
.Display
.send
End With

MsgBox "votre mail a été envoyé", vbInformation + vbOKOnly, "confirmation d'envoi"

Application.ScreenUpdating = True

Sheets("Dashboard").Select
Range("A4").Select
End Sub
 

Statistiques des forums

Discussions
312 207
Messages
2 086 238
Membres
103 162
dernier inscrit
fcfg