Renommage feuille avant envoi

Le 14/09/2017 à 12:45

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

Le 14/09/2017 à 14:06

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

Le 14/09/2017 à 15:27

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

Le 14/09/2017 à 16:20

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,

Le 14/09/2017 à 16:49

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.

3envoi-auto.xlsm (53.91 Ko)
Le 14/09/2017 à 17:02

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,

Le 14/09/2017 à 18:13

Non je n'ai pas essayé, mais voici le fichier déverrouillé...désolé...

6envoi-auto-2.xlsm (49.05 Ko)
Le 15/09/2017 à 09:26

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,

Le 15/09/2017 à 10:09

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

Le 15/09/2017 à 10:19

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,

Le 15/09/2017 à 11:02

Merci pour ton aide, je vais voir si j'arrive à arriver au bon résultat.

Bonne journée.

Le 15/09/2017 à 14:01

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
Le 15/02/2018 à 12:45

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.

Rechercher des sujets similaires à "renommage feuille envoi"