Renommage feuille avant envoi
Bonjour,
Afin d'obtenir régulièrement des informations de la part de mes collaborateurs je leur envoi un fichier Excel comportant X onglets identiques nommés selon la ville de travail.
J'ai la macro ci-dessous qui leur permet en cliquant sur un bouton de m'envoyer automatiquement la feuille leur correspondant. Cela fonctionne très bien mais la feuille que je reçois s'appelle Classeur 1.
Comment la renommer automatiquement selon la valeur d'une cellule (pour moi ce sera I1) avant envoi ?
D'avance merci.
Sub envoi_PARIS()
'MsgBox Oui + Non
Dim Destinataires(3) As String, Sujet As String
Dim AccuseReception As Boolean
'Modifier les mails des destinataires
Destinataires(1) = "xxxxxxxx@xxxxx.fr"
'Destinataires(2) = "@"
'Destinataires(3) = "@"
Sujet = ActiveSheet.Range("I1")
AccuseReception = True
Select Case MsgBox("Merci pour votre contribution. Votre message va être envoyé à xxxxxxxx@xxxxx.fr." & vbCrLf & vbCrLf & "Vous recevrez bientôt un accusé de lecture dans votre messagerie." & vbCrLf & vbCrLf & "VOULEZ-VOUS VRAIMENT TRANSMETTRE LA FEUILLE DE CALCUL ?", vbYesNo, "TRANSMISSION DE LA FEUILLE")
Case vbYes
'procédure si click sur Oui
ThisWorkbook.Sheets("PARIS").Copy
ActiveWorkbook.SendMail Destinataires, Sujet, AccuseReception
ActiveWorkbook.Close False
Case vbNo
'procédure si click sur Non
End Select
End Sub
Salut,
Dim anciennom as string
Dim nouveaunom as string
anciennom = activesheet.name
nouveaunom = range("L1").value
activesheet.name = nouveaunom
'.
'. TON CODE
'.
activesheet.name = anciennom
je pense qu'en l'intégrant dans ton cela devrait fonctionner
Merci pour la réponse.
Je viens d'essayer en insérant le code comme ci-dessous mais ça me renvoi une erreur 400 :
Sub envoi_PARIS()
'MsgBox Oui + Non
Dim Destinataires(3) As String, Sujet As String
Dim AccuseReception As Boolean
Dim anciennom As String
Dim nouveaunom As String
'Modifier les mails des destinataires
Destinataires(1) = "xxxxxxxx@xxxxx.fr"
'Destinataires(2) = "@"
'Destinataires(3) = "@"
anciennom = ActiveSheet.Name
nouveaunom = Range("I1").Value
ActiveSheet.Name = nouveaunom
Sujet = ActiveSheet.Range("I1")
AccuseReception = True
Select Case MsgBox("Merci pour votre contribution. Votre message va être envoyé à xxxxxxxx@xxxxx.fr." & vbCrLf & vbCrLf & "Vous recevrez bientôt un accusé de lecture dans votre messagerie." & vbCrLf & vbCrLf & "VOULEZ-VOUS VRAIMENT TRANSMETTRE LA FEUILLE DE CALCUL ?", vbYesNo, "TRANSMISSION DE LA FEUILLE")
Case vbYes
'procédure si click sur Oui
ThisWorkbook.Sheets("PARIS").Copy
ActiveSheet.Name = anciennom
ActiveWorkbook.SendMail Destinataires, Sujet, AccuseReception
ActiveWorkbook.Close False
Case vbNo
'procédure si click sur Non
End Select
End Sub
Re,
Hmm.. je ne vois pas ou tu rajoute une pièce-jointe dans ton code..
Aussi, peut être cette ligne produit une erreur :
Sujet = ActiveSheet.Range("I1")
Il faut mettre
Sujet = ActiveSheet.Range("I1").Value
Puis t'a une redondance de variable entre sujet et nouveaunom (c'ma faute j'avais pas vue). Tu peux enlever nouveau nom.
Tu as une deuxième macro qui est appelée quand tu choisi de transmettre la feuille en fait ?
Et, je viens d'y penser, mais peut être parce que c'est pas la feuille qui s'appelle "Classeur 1" mais ton classeur même.
Si tu veux que je t'aide met un fichier sur lequel il est possible de travailler ou au moins toutes les macros qui interviennent dans ta procédure s'il te plait.
Cdlt,
J'ai essayé mais je ne vois pas trop...
En pièce jointe une version épurée de mon tableur.
En fait je veux que le sujet du mail soit la case I1 et le nom de classeur aussi pour des questions de classement.
Merci de ton aide.
Oui, j'avais bien compris ce que tu voulais.
Le problème n'est pas dans le nom de la feuille mais dans le du Classeur dans lequel tu enregistre ta feuille. En fait, tu exporte ta feuille au format excel mais sans renommer le fichier du coup il s'appelle "Classeur 1" comme quand tu enregistre une image Paint vide, elle se nommera "sans titre".
Enfin, c'est mon avis. Je pense que c'est de la que viens le problème. A tu essayer de simplement exporter ta feuille avec ton code VBA (sans la mettre en pièce-jointe) dans un répertoire et de voir le nom du fichier et en l'ouvrant tu verra que le nom de la feuille n'a pas changer normalement.
Car, le nom par défaut d'une feuille est "Feuil1" est pas "Classeur 1".
Malheureusement tes codes VBA sont protégés par un code je ne peux pas y accéder.
Cdlt,
Non je n'ai pas essayé, mais voici le fichier déverrouillé...désolé...
Re,
Tqt pas besoin de t'excuser c'est pour toi Ahah
Tien essaie avec ce code :
Sub envoi_dreux()
'MsgBox Oui + Non
Dim Destinataires(3) As String, Sujet As String
Dim AccuseReception As Boolean
Dim anciennom As String
Dim nouveaunom As String
'Modifier les mails des destinataires
Destinataires(1) = "contact2@archimede-eval.fr"
'Destinataires(2) = "@"
'Destinataires(3) = "@"
anciennom = ActiveSheet.Name
nouveaunom = Range("I1").Value
ActiveSheet.Name = nouveaunom
Sujet = ActiveSheet.Range("I1").Value
AccuseReception = True
Select Case MsgBox("Merci pour votre contribution. Votre message va être envoyé à nico-transe@hotmail.fr." & vbCrLf & vbCrLf & "Vous recevrez bientôt un accusé de lecture dans votre messagerie." & vbCrLf & vbCrLf & "VOULEZ-VOUS VRAIMENT TRANSMETTRE LA FEUILLE DE CALCUL ?", vbYesNo, "TRANSMISSION DE LA FEUILLE")
Case vbYes
'procédure si click sur Oui
ThisWorkbook.Sheets("DREUX_NOVEMBRE 2017").Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Sujet & ".xltm", _
FileFormat:=xlOpenXMLTemplateMacroEnabled, Password:="", WriteResPassword _
:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.SendMail Destinataires, Sujet, AccuseReception
ActiveWorkbook.Close False
Case vbNo
'procédure si click sur Non
End Select
End Sub
Adapte le à tes besoins au niveau du nom de la feuille et de la destination de sauvegarde mais normalement sa marche !!
Cdlt,
Bonjour,
Merci pour la réponse. J'ai adapté mais j'ai une erreur de compilation sur la ligne Select Case MsgBox (ligne en rouge quand je la met dans l'éditeur).
Ci dessous le code ou j'ai remis le nom de la feuille. Par contre j'ai une question un peu bête mais comment je formalise la destination de sauvegarde ?
Sub envoi_dreux()
'MsgBox Oui + Non
Dim Destinataires(3) As String, Sujet As String
Dim AccuseReception As Boolean
Dim anciennom As String
Dim nouveaunom As String
'Modifier les mails des destinataires
Destinataires(1) = "n.renault@citra.fr"
'Destinataires(2) = "@"
'Destinataires(3) = "@"
anciennom = ActiveSheet.Name
nouveaunom = Range("I1").Value
ActiveSheet.Name = nouveaunom
Sujet = ActiveSheet.Range("I1").Value
AccuseReception = True
Select Case MsgBox("Merci pour votre contribution. Votre message va être envoyé à <!-- e --><a href="mailto:n.renault@citra.fr">n.renault@citra.fr</a><!-- e -->." & vbCrLf & vbCrLf & "Vous recevrez bientôt un accusé de lecture dans votre messagerie." & vbCrLf & vbCrLf & "VOULEZ-VOUS VRAIMENT TRANSMETTRE LA FEUILLE DE CALCUL ?", vbYesNo, "TRANSMISSION DE LA FEUILLE")
Case vbYes
'procédure si click sur Oui
ThisWorkbook.Sheets("DREUX").Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Sujet & ".xltm", _
FileFormat:=xlOpenXMLTemplateMacroEnabled, Password:="", WriteResPassword _
:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.SendMail Destinataires, Sujet, AccuseReception
ActiveWorkbook.Close False
Case vbNo
'procédure si click sur Non
End Select
End Sub
Re,
Tu peut définir la destination avec une variable.
Dim chemin as string
Chemin = "XX\XX\XX\DOSSIER"
Et il faudrat introduire cette variable à ce niveau :
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Sujet & ".xltm"
Comme ceci :
ActiveWorkbook.SaveAs Chemin & "\" & Sujet & ".xltm"
ThisWorkbook.Path renvoie le chemin du répertoire ou est enregistré le dossier d'origine.
Sinon pour gérer tes réponses VByes ou Vbno, je te conseil de procéder comme indiqué dans ce poste https://forum.excel-pratique.com/excel/executer-une-macro-si-reponse-msgbox-est-oui-t28092.html.
Aussi, je ne suis pas un expert du VBA (pas encore du moins) et je n'ai jamais utilisé la procédure "Select Case" et "Case", Désolé !
J'espère que tu pourra t'en sortir avec ça !
Cdlt,
Merci pour ton aide, je vais voir si j'arrive à arriver au bon résultat.
Bonne journée.
Bonjour nickal, ...
Voici une proposition.... à mettre dans un module standard et non dans un module de feuille...
Quelques explications :
1) J'ai mis dans ton onglet masqué "LISTE" une table des destinataires à laquelle je me réfère pour gérer les envois (il me semble en effet qu'il y a (peut avoir) plusieurs destinataires)
2) L'onglet "ACTIF" (et seulement celui-là) de ton collègue est copié vers un nouveau classeur nommé du nom de cette feuille, mais ce classeur n'est pas enregistré.
Sub Envoi()
Dim tabDest()
Dim melSujet As String
Dim melAccuseReception As Boolean
Dim melFeuille As String
Dim nomActuel
Dim cptEnvoi
Dim savEnvoi As Boolean
Dim repEnvoiOk As Boolean
tabDest = Range("listeEnvoi")
nomActuel = ActiveSheet.Name
melFeuille = Range("I1").Value
Sujet = melFeuille
AccuseReception = True
Application.ScreenUpdating = False
savEnvoi = False
For cptEnvoi = 1 To UBound(tabDest, 1)
If Not (tabDest(cptEnvoi, 3) = "") Then
repEnvoiOk = _
MsgBox( _
"Merci pour votre contribution." & _
"Votre message va être envoyé à " & tabDest(cptEnvoi, 2) & _
vbCrLf & vbCrLf & _
"Vous recevrez bientôt un accusé de lecture dans votre messagerie." & _
vbCrLf & vbCrLf & _
"VOULEZ-VOUS VRAIMENT TRANSMETTRE LA FEUILLE DE CALCUL ?", _
vbQuestion + vbYesNo, "TRANSMISSION DE LA FEUILLE") _
= vbYes
If Not savEnvoi Then
' Exporter la feuille en la renommant
ActiveWorkbook.ActiveSheet.Copy
With ActiveWorkbook
.Sheets(1).Name = melFeuille
.ActiveSheet.Shapes.Range(Array("btnValider")).Delete
End With
' Une seule fois
savEnvoi = True
End If
If repEnvoiOk Then
' Procedure si Confiramation
ActiveWorkbook.SendMail tabDest(cptEnvoi, 3), Sujet, AccuseReception
Else
' Procedure si Non Confirmation
MsgBox "Votre envoi a été annulé !", vbInformation + vbOKOnly, "Pour information"
End If
End If
Next
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End Sub
Bonjour,
Je reviens vers toi concernant ta solution donnée l'an passé suite à mon besoin.
Je dois faire une petite évolution mais n'étant pas expert en VBA je n'arrive pas à comprendre une petite chose :
Comment la macro va chercher le tableau car je ne vois de nom de tableau ou de plages nul part ?
En fait mon tableur actuel comporte plusieurs feuilles selon la nature des données, et selon la feuille, la liste des destinataires est différente.
Je cherche donc à soit créer plusieurs tableau de destinataires, soit un seule avec numéro 1 à 10 pour tel envoi, 11 à 20 pour tel autre etc., et c'est là que je suis bloqué...
Si il y a une solution simple je ne la voit malheureusement pas !
Merci d'avance pour ton aide.