Creation d'onglet en VBA pour générer courriers

jjjerome

XLDnaute Occasionnel
Bonjour le forum,
Je fais une nouvelle fois appel à vos connaissances.
Pour mon travail, j'ai des courriers de prévenance de travaux a faire.

Les adresses se trouvent dans un onglet, ou il est précisé la semaine ou ces lettres doivent être envoyées.

Je souhaiterai donc qu'en séléctionnant la semaine, les références client soient affichées, et qu'un nouvel onglet pour chaque lettre à faire soit générée, à partir du courrier type, et avec les adresses et contact correctement renseignés.

Un exemple ci-joint.

Merci de votre aide
 

Fichiers joints

Papou-net

XLDnaute Barbatruc
Re : Creation d'onglet en VBA pour générer courriers

Bonsoir jjjerome,

Regarde si cette solution te convient.

Espérant avoir répondu.

Cordialement.
 

Fichiers joints

jjjerome

XLDnaute Occasionnel
Re : Creation d'onglet en VBA pour générer courriers

Merci Papou-net pour cette réponse aussi rapide !
Mais j'ai regardé le code, et ça ma fait peur, je crois que je vais avoir beaucoup de mal à l'adapter à mon fichier, je suis novice :confused:

Pour que ce soit plus clair pour moi, est-il possible dans un premier temps d'afficher la liste des reference suivant le choix de la semaine (ou pouvoir faire un copier coller d'une liste), puis a l'aide d'un bouton générer les courriers ?
S'il était aussi possible de détailler ton code, ce serait top !

Quand je change de semaine, j'ai systematiquement ton message : "Ce courrier existe déjà ! Voulez-vous le remplacer ?" qui apparait, puis il me renvoi une erreur sur VBA.

J'avais éssayé avec l'enregistreur de macro sur un autre fichier, ça ne me donnait pas dutout la même chose, je l'avais ensuite étendu, ça marchait mais ce n'était pas très concluant... Dés que je changeait de ref, ça me changait aussi le contenu de mes onglets déjà créé... Voici le code

HTML:
    Sheets("Courrier").Select
    Sheets("Courrier").Copy After:=Sheets(4)
    Range("C18:D18").Select
    ActiveCell.FormulaR1C1 = "='A envoyer'!R[-12]C[-1]"
    Sheets("A envoyer").Select
    Sheets("Courrier(2)").Select
    Sheets("Courrier(2)").Name = Sheets("A envoyer").Range("B6")
    Range("A7").Select
    
  Sheets("Courrier").Select
    Sheets("Courrier").Copy After:=Sheets(4)
    Range("C18:D18").Select
    ActiveCell.FormulaR1C1 = "='A envoyer'!R[-11]C[-1]"
    Sheets("A envoyer").Select
    Sheets("Courrier(2)").Select
    Sheets("Courrier(2)").Name = Sheets("A envoyer").Range("B7")
    Range("A7").Select
 

jjjerome

XLDnaute Occasionnel
Re : Creation d'onglet en VBA pour générer courriers

Bonjour le forum,

Autre chose, dans la ligne suivante, a quoi correspond : R1C1 ; -12 et -1, pourquoi des valeurs négative ??


HTML:
ActiveCell.FormulaR1C1 = "='A envoyer'!R[-12]C[-1]"
 

ChTi160

XLDnaute Barbatruc
Re : Creation d'onglet en VBA pour générer courriers

Salut jjjerome
Bonjour le fil
Bonjour le Forum

On peut aussi récupérer les identifiants de la semaine (dans un tableau)et les coller dans la cellule C18 de la lettre type (les uns après les autres) et mettre par exemple
la formule un peu modifié en G8 =SI(ESTERREUR(RECHERCHEV(C18;Adresses!B4:H28;3;0));"";RECHERCHEV(C18;Adresses!B4:H28;3;0))
(Modifier les autres formules G9 ,G10,G11)
et faire la création de feuilles
je dois partir au boulot
je regarde cela ce soir pour voir ou ca en est Lol
Bonne journée
 

Papou-net

XLDnaute Barbatruc
Re : Creation d'onglet en VBA pour générer courriers

Bonjour Jérôme, ChTi160,

Jérôme, il était tard cette nuit lorsque j'ai répondu à ta demande, et je n'avais pas testé les macros entièrement.

Il y avait donc des erreurs que je viens de corriger.

La mise à jour ne se fait plus automatiquement dès que la cellule B5 est modifiée, mais au moyen d'un bouton que j'ai placé à droite de cette cellule. Ca rejoint donc la demande que tu as faite.

Si tu crées un bouton semblable sur ton fichier, et que tu y affectes les 2 macros que je t'ai écrites, tu ne devrais pas avoir trop de difficultés à adapter l'ensemble à ton projet.

Je t'enverrai ultérieurement une copie commentée de mes macros, pour que tu en comprennes le fonctionnement. Pour le moment, saches que la première macro (Sub CommandButton1_Click) reporte tes références de courrier sur ta feuille principale, puis appelle la macro (Sub Courriers) qui vérifie si les feuilles existent déjà et qui crée les nouvelles feuilles.

Espérant t'avoir aidé.

Cordialement.
 

Fichiers joints

Papou-net

XLDnaute Barbatruc
Re : Creation d'onglet en VBA pour générer courriers

Bonjour Jérôme,

Comme promis, voici les codes commentés.

Code:
Private Sub CommandButton1_Click()
Dim Lg As Long ' Variable définissant le n° de ligne sur la feuille Recap

Range("B8:B65536").ClearContents ' Vide les cellules en colonne B, Feuille Recap
Lg = 8 ' Définit la ligne de départ pour inserion des références en colonne B, Feuille Recap
' Lit en boucle les n° de semaines sur la feuille Adresse
' La lecture commence en ligne 4 et s'arrête sur la dernière cellule remplie dans la colonne A
For Each cel In Sheets("Adresses").Range("A4:A" & Sheets("Adresses").Range("A65536").End(xlUp).Row)
  ' Si le N° de semaine correspond à la cellule B5
  If cel.Value = Range("B5").Value Then
    ' On ajoute la référence à la ligne
    Cells(Lg, 2) = Sheets("Adresses").Cells(cel.Row, 2)
    ' et on fixe la position de la ligne suivante
    Lg = Lg + 1
  End If
Next
' Appel de la macro de mise à jour/création des feuilles
Courriers

End Sub

Sub Courriers()
' RefCourrier contient la référence du courrier
' ListCourrier contient les noms des feuilles déjà présentes dans le classeur
Dim RefCourrier As String, ListCourriers As String
' LRef contient le n° de ligne de la référence trouvée
Dim LRef As Long
' Trouve détermine si une feuille est existante ou pas
Dim Trouve As Boolean

Application.DisplayAlerts = False ' Empêche l'affichage des messages sytème
ListCourriers = ""
' Balayage des feuilles existantes dans le classeur
For Each sh In Sheets
  ' Si la feuille n'est pas dans la liste, on l'y ajoute (avec une virgule de séparation
  If InStr(ListCourriers, sh.Name) = 0 Then ListCourriers = ListCourriers & sh.Name & ","
Next
' Balayage de la colonne B, lignes 8 à dernière ligne remplie
For Each cel In Range("B8:B" & Range("B65536").End(xlUp).Row)
  RefCourrier = cel.Value ' Affecte la valeur de la cellule lue à la variable RefCourrier
  If InStr(ListCourriers, RefCourrier) > 0 Then
    ' Si RefCourrier est dans la liste
    Trouve = True ' Trouve = vrai
    ' Affiche la boîte de message Courrier existant
    rep = MsgBox("Le courrier " & RefCourrier & " existe déjà !" & vbCrLf & "Voulez-vous le remplacer ?", vbYesNo + vbQuestion, "COURRIER EXISTANT")
    Else
    Trouve = False ' Sinon Trouve = faux
  End If
  If rep = vbNo Then GoTo Suite ' Si on a répondu Non à la boîte de dialogue, on boucle à la cellule suivante
  ' Si on a répondu Oui
  ' Et si Trouve = vrai, alors on supprime la feuille existante
  If Trouve = True Then Sheets(RefCourrier).Delete
  ' Copie et place en dernière position la feuille Courrier Type
  Sheets("Courrier Type").Copy After:=Sheets(Sheets.Count)
  ' Affiche la feuille Récap
  Sheets("Recap").Activate
  ' Toutes les actions suivantes se font sur la feuille qui vient d'être copiée
  With Sheets(Sheets.Count)
    ' Renomme la feuille
    .Name = RefCourrier
    ' Cherche la référence dans la colonne B de la feuille Adresses
    Set Ref = Sheets("Adresses").Range("B:B").Find(RefCourrier, LookIn:=xlValues, lookat:=xlWhole)
    ' Si la référence est trouvée
    If Not Ref Is Nothing Then
      ' On recupère son n° de ligne
      LRef = Ref.Row
      ' Et on recopie les données dans les cellules de la feuille qui vient d'être copiée
      .Range("C18") = Sheets("Adresses").Cells(LRef, 2)
      .Range("G7") = Sheets("Adresses").Cells(LRef, 3)
      .Range("G8") = Sheets("Adresses").Cells(LRef, 4)
      .Range("G9") = Sheets("Adresses").Cells(LRef, 5)
      .Range("G10") = Sheets("Adresses").Cells(LRef, 6)
      .Range("G11") = Sheets("Adresses").Cells(LRef, 7) & " " & Sheets("Adresses").Cells(LRef, 8)
    End If
  End With
Suite:
Next cel
Application.DisplayAlerts = True ' Rétablit l'affichage des messages sytème
End Sub
Cordialement.
 

jjjerome

XLDnaute Occasionnel
Re : Creation d'onglet en VBA pour générer courriers

Bonjour à tous,
Merci pour ces explications, je vais voir ce que ça donne pour l'adapter, ca devrait le faire !! Merci
Par contre, lorsque je supprime les onglets créés, j'ai ensuite une ereur sur cette ligne :

HTML:
 Sheets("Courrier Type").Copy After:=Sheets(Sheets.Count)
Je souhaiterai ensuite enregistrer en .pdf chaque courrier, pour une autre application, j'avais utilisé le code suivant (que j'avais également trouvé sur ce forum, ;) ) et qui fonctionne bien. par contre dire d'enregistrer chaque nouvel onglet créé dans un PDF différent ???

HTML:
Sub Tst_PdfCreator()
' Dim objMessage As CDO.Message
Dim jobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
 
' Dim Chemin As String
  
'Enregistrement du classeur (instruction désactivée)
'    ActiveWorkbook.Save
  
 ' Chemin = ThisWorkbook.Path & "\Courriers Bailleurs\"
  'préfixe = Sheets("Infos").Range("B1") & ("-Courrier Bailleur-IP Natif 2010-") & Sheets("Infos").Range("D1").Value
  
  ' à adapter en fonction des noms de tes onglets
  Sheets(Array("Courrier Bailleur")).Copy
  'Sheets (Array(Sheets("Infos").Range("B1").Copy
    sNomPDF = "Essai.pdf"
    sCheminPDF = ActiveWorkbook.Path & Application.PathSeparator
 
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
 
    Set jobPDF = CreateObject("PDFCreator.clsPDFCreator")
 
    With jobPDF
        If .cStart("/NoProcessingAtStartup") = False Then
            MsgBox "Initialisation de PDFCreator impossible", vbCritical + vbOKOnly, "PDFCreator"
            Exit Sub
        End If
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sCheminPDF
        .cOption("AutosaveFilename") = sNomPDF
 
        '0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
        .cOption("AutosaveFormat") = 0
        .cClearCache
    End With
 
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
 
    'Fichier dans la file d'attente
    Do Until jobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    jobPDF.cPrinterStop = False
 
    'Attendre que la file d'attente soit vide
    Do Until jobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop
    jobPDF.cClose
    Set jobPDF = Nothing
     
 '   Set objMessage = CreateObject("CDO.Message")
  '  With objMessage
   '     .Subject = "Essai"
   '     .From = "xxxxx@wanadoo.fr"
   '     .To = "yyyyy@wanadoo.fr"
   '     .TextBody = "Texte dans le corps de message"
   '     .AddAttachment sCheminPDF & sNomPDF
   '     .Send
 '   End With
     
  '  Set objMessage = Nothing
End Sub
 

Papou-net

XLDnaute Barbatruc
Re : Creation d'onglet en VBA pour générer courriers

Bonjour à tous,
Merci pour ces explications, je vais voir ce que ça donne pour l'adapter, ca devrait le faire !! Merci
Par contre, lorsque je supprime les onglets créés, j'ai ensuite une ereur sur cette ligne :

HTML:
 Sheets("Courrier Type").Copy After:=Sheets(Sheets.Count)
Je souhaiterai ensuite enregistrer en .pdf chaque courrier, pour une autre application, j'avais utilisé le code suivant (que j'avais également trouvé sur ce forum, ;) ) et qui fonctionne bien. par contre dire d'enregistrer chaque nouvel onglet créé dans un PDF différent ???

HTML:
Sub Tst_PdfCreator()
' Dim objMessage As CDO.Message
Dim jobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
 
' Dim Chemin As String
  
'Enregistrement du classeur (instruction désactivée)
'    ActiveWorkbook.Save
  
 ' Chemin = ThisWorkbook.Path & "\Courriers Bailleurs\"
  'préfixe = Sheets("Infos").Range("B1") & ("-Courrier Bailleur-IP Natif 2010-") & Sheets("Infos").Range("D1").Value
  
  ' à adapter en fonction des noms de tes onglets
  Sheets(Array("Courrier Bailleur")).Copy
  'Sheets (Array(Sheets("Infos").Range("B1").Copy
    sNomPDF = "Essai.pdf"
    sCheminPDF = ActiveWorkbook.Path & Application.PathSeparator
 
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
 
    Set jobPDF = CreateObject("PDFCreator.clsPDFCreator")
 
    With jobPDF
        If .cStart("/NoProcessingAtStartup") = False Then
            MsgBox "Initialisation de PDFCreator impossible", vbCritical + vbOKOnly, "PDFCreator"
            Exit Sub
        End If
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sCheminPDF
        .cOption("AutosaveFilename") = sNomPDF
 
        '0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
        .cOption("AutosaveFormat") = 0
        .cClearCache
    End With
 
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
 
    'Fichier dans la file d'attente
    Do Until jobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    jobPDF.cPrinterStop = False
 
    'Attendre que la file d'attente soit vide
    Do Until jobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop
    jobPDF.cClose
    Set jobPDF = Nothing
     
 '   Set objMessage = CreateObject("CDO.Message")
  '  With objMessage
   '     .Subject = "Essai"
   '     .From = "xxxxx@wanadoo.fr"
   '     .To = "yyyyy@wanadoo.fr"
   '     .TextBody = "Texte dans le corps de message"
   '     .AddAttachment sCheminPDF & sNomPDF
   '     .Send
 '   End With
     
  '  Set objMessage = Nothing
End Sub
Bonsoir Jérôme,

Concernant le premier point : comment procèdes-tu pour supprimer les feuilles ? J'ai moi-même supprimé plusieurs fois les feuilles créées par macro, lors de mes différents essais, et n'ai eu aucune erreur. L'erreur que tu signales me semble correspondre à la suppression de la feuille "Courrier Type", mais je ne pense pas que tu veuilles justement supprimer cet onglet.

Concernant le deuxième point, je ne suis pas encore en mesure de te répondre, du moins pour le moment, car je n'ai encore jamais pratiqué l'export de fichiers pdf dans Excel. Je tâcherai d'y regarder un peu plus tard, si tu n'as pas eu d'autres réponses, car pour l'heure, je suis un peu débordé.

Cordialement.
 

Discussions similaires


Haut Bas