IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Utiliser CreateNavigator dans création mail Lotus Notes [XL-2007]


Sujet :

Macros et VBA Excel

  1. #1
    Membre actif Avatar de pastis.vi
    Homme Profil pro
    Ingénieur qualité méthodes
    Inscrit en
    Novembre 2008
    Messages
    251
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Ingénieur qualité méthodes
    Secteur : Industrie

    Informations forums :
    Inscription : Novembre 2008
    Messages : 251
    Points : 209
    Points
    209
    Par défaut Utiliser CreateNavigator dans création mail Lotus Notes
    Bonjour à tous,

    J'ai déjà créé un sujet sur la création d'un tableau dans un mail Lotus Notes (avant envoi du mail).
    Une particularité du tableau c'est de le remplir avec CreateNavigator.

    L'outil CreateNavigator permet de renseigner un tableau dans l'odre suivant:
    Nom : tab1.png
Affichages : 262
Taille : 1,7 Ko
    De gauche à droite puis de haut en bas comme sur l'exemple ci-dessus.

    Je vous joins mon fichier : Pièce jointe 167906
    La macro du fichier permet d'envoyer des mails de relance automatiques. Comme il n'est pas possible de copier/coller un tableau Excel dans Lotus je créé le tableau directement dans le mail. Pour "naviguer" dans le tableau j'utilise une variable appelée rtnav.

    Ce fichier fonctionne très bien: chaque action, porteur d'action, etc est bien inscrit dans les cases du tableau.

    Sauf que lorsque je souhaite rajouter une colonne ou faire des modifications dans mon fichier Excel, j'ai beau adapter le code, j'obtiens : chaque action, porteur d'action, etc se trouve inscrit en dehors du tableau (dessous en l’occurrence).

    Je ne sais pas si j'exprime correctement le problème. Mais globalement c'est mon CreateNavigator qui pose problème. Comme je suis avide d'information je prends tout ce qui est à prendre comme conseil !

    Merci beaucoup pour le coup de pouce !


    ps, je balance le code pour ceux qui ne souhaiteraient pas télécharger le fichier :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    Sub envoi_mail_Suivi()
     
        'Déclaration
        Dim Maildb As Object                'La database des mails
        Dim UserName As String              'Le nom d'utilisateur
        Dim MailDbName As String            'Le nom de la database des mails
        Dim MailDoc As Object               'Le mail
        Dim Session As Object               'La session Notes
        Dim Signature As String             'La signature
        Dim Sujet As String                 'Le sujet du mail
        Dim sHeaders(4) As String           'Les noms d'en-têtes du tableau
        Dim Reference(50) As String         'Les valeurs de la colonne 1 du tableau
        Dim Defaut(50) As String            'Les valeurs de la colonne 2 du tableau
        Dim Action(50) As String            'Les valeurs de la colonne 3 du tableau
        Dim Cible(50) As String             'Les valeurs de la colonne 4 du tableau
        Dim rtsTableHeader As Object        'Mise en forme du texte en-têtes
        Dim rtsTableRow As Object           'Mise en forme du texte cellules tableau
        Dim Destinataire(0) As Variant      'Liste destinataire
        Dim ccDestinataires(2) As Variant   'Liste destinataires en copie
        Dim derligne As Integer             'Dernière ligne de la liste des destinataires
        Dim ligdeb As Integer               'Première ligne, après filtre, de la liste des actions
        Dim ligfin As Integer               'Dernière ligne, après filtre, de la liste des actions
        Dim nbrow As Integer                'Nombre de lignes du tableau
        Dim nbcol As Integer                'Nombre de colonnes du tableau
        Dim rtnav As Object                 'Variable de recherche dans le tableau
        Dim jour As Long                    'Date du jour
     
    '------------------------------------------------------------------------------------------------------------------------------
    'RECUPERATION DES DONNEES CLASSEUR:
            Sheets("SUIVI CRIMES").Select
            Range("$B$5:$Q$60000").AutoFilter Field:=5
            Range("$B$5:$Q$60000").AutoFilter Field:=7
            Range("$B$5:$Q$60000").AutoFilter Field:=14
            Range("$B$5:$Q$60000").AutoFilter Field:=14, Criteria1:="="                                 'Filtre sur les actions non soldées
            jour = Date
            Range("$B$5:$Q$60000").AutoFilter Field:=7, Criteria1:="<" & jour                           'Filtre sur les actions ayant dépassé la date cible
     
        ' Défini les numéro de lignes (début et fin) lors du filtrage sur la colonne G)
            Set Plage = [_filterdatabase].Offset(1).Resize(, 1)
            Set Plage = Plage.Resize(Plage.Count - 1).SpecialCells(xlCellTypeVisible)                   'Détermine la plage de cellules visibles
     
        ' Identifie les destinataires et mails à envoyer
            ligdeb = Plage.Row                                                                          'Première ligne de la plage filtrée
            ligfin = Range("F60000").End(xlUp).Row                                                      'Dernière ligne de la plage filtrée
            Range("F" & ligdeb & ":F" & ligfin).SpecialCells(xlCellTypeVisible).Copy                    'On copie la plage de données visible
            Sheets("Calculs").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Sheets("Calculs").Range("$A$1:$A$" & ligfin - 5).RemoveDuplicates columns:=1, Header:=xlNo
            If Sheets("Calculs").Range("A2").Value = "" Then                                            'Détermine la dernière ligne de la liste des destinataires
                derligne = 1
            Else
                derligne = Sheets("Calculs").Range("A1").End(xlDown).Row
            End If
     
            For d = 1 To derligne                                                                       'Créé le mail et l'envoi pour chaque déstinataire : 1 boucle = 1 destinataire
                Range("$B$5:$Q$60000").AutoFilter Field:=5, Criteria1:=Sheets("Calculs").Range("A" & d).Value 'Filtre sur l'action du destinataire
                Set Plage = [_filterdatabase].Offset(1).Resize(, 1)
                Set Plage = Plage.Resize(Plage.Count - 1).SpecialCells(xlCellTypeVisible)
                If Range("G" & Plage.Row).Value = "" Then GoTo IterationSuivante                        'Si le mail n'est pas renseigné, le mail n'est pas créé et on passe au destinataire suivant
                Range("B5").Offset(1, 0).Select                          'Donne la première ligne de notre tableur après le filtre
                i = 0
                j = 0
     
                Do While j < 2                                           'Va jusqu'à 2 lignes vides après la dernière ligne visible filtrée
                    Do While ActiveCell.EntireRow.Hidden = True          'Teste si la ligne est visible
                        ActiveCell.Offset(1, 0).Select                   'On se déplace dans notre tableur : +1 ligne
                    Loop
                    i = i + 1
                    If ActiveCell = "" Then                              'Si la cellule ext vide alors...
                        j = j + 1
                    Else
                        Reference(i) = ActiveCell.Value                  'Enregistre les valeurs, pour chaque ligne visible, dans des tables définies
                        Defaut(i) = ActiveCell.Offset(0, 1).Value
                        Action(i) = ActiveCell.Offset(0, 3).Value
                        Cible(i) = ActiveCell.Offset(0, 6).Value
                    End If
                ActiveCell.Offset(1, 0).Select
                Loop
     
    '------------------------------------------------------------------------------------------------------------------------------
    'CREATION DU MAIL:
                Sujet = "Suivi du portefeuille des actions CRIME"                       'On défini la variable Sujet
                Destinataire(0) = Range("G" & Plage.Row).Value                          'On défini la variable Destinataire
                ccDestinataires(0) = "tutu@gmail.com"                                   'On défini la variable ccDestinataire
     
                Set Session = CreateObject("Notes.NotesSession")                        'Crée une session notes
                UserName = Session.UserName                                             'Récupère le nom d'utilisateur et crée le nom de la base des mails
                MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
                Set Maildb = Session.GetDatabase("", MailDbName)                        'Ouvre la base des mails
                If Not Maildb.IsOpen Then Maildb.OPENMAIL                               'Test si la base mail est bien ouverte
                Set MailDoc = Maildb.CreateDocument                                     'Paramètre le mail à envoyer
                'Call MailDoc.AppendItemValue("Form", "Memo")
                'Call MailDoc.AppendItemValue("sendTo", Destinataire)                    'Paramètre les destinataires des mails (par la table Destinataires)
                'Call MailDoc.AppendItemValue("CopyTo", ccDestinataires)                 'Paramètre les destinataires en copie des mails (par la table ccDestinataires)
                'Call MailDoc.AppendItemValue("Subject", Sujet)
     
                nbcol = 4                       'Paramètre le nombre de colonnes du tableau
                nbrow = Plage.Count + 1         'Paramètre le nombre de lignes du tableau (basé sur le nombre d'actions affectées au destinataire)
     
                sHeaders(0) = "Référence"       'Première en-tête du tableau
                sHeaders(1) = "Défaut"          'Seconde en-tête du tableau
                sHeaders(2) = "Action"          'Troisième en-tête du tableau
                sHeaders(3) = "Date Cible"      'Quatrième en-tête du tableau
     
                'Signature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)                   'Récupération de la signature Notes
                'MailDoc.AppendItemValue ("iTitle"), Maildb.GetProfileDocument("CalendarProfile").GetItemValue("iTitle") 'Récupération du titre
                'MailDoc.Logo = "StdNotesLtr99"
     
     
    'CORPS DU MESSAGE:
                Set rtitem = MailDoc.CreateRichTextItem("Body")                 'Paramètre le corps du mail
     
                Call rtitem.AppendText("Bonjour,")                              'Marque "Bonjour"
                Call rtitem.AddNewLine(2)                                       'Ajoute un saut de ligne
                If nbrow = 1 Then Call rtitem.AppendText("Voici, ci-dessous, l'action en cours qui vous est affectée :")       'Si une seule action alors ce texte
                If nbrow >= 2 Then Call rtitem.AppendText("Voici, ci-dessous, les actions en cours qui vous sont affectées :")  'Si plusieurs actions alors ce texte
                Call rtitem.AddNewLine(2)
     
                   Set rtsTableHeader = Session.CreateRichTextStyle             'Paramètre la police des en-têtes
                         rtsTableHeader.Bold = True                             'Texte en gras
                         rtsTableHeader.FontSize = 12                           'Texte en taille 12
     
                    Set rtsTableRow = Session.CreateRichTextStyle               'Paramètre la police des cellules
                        rtsTableRow.Bold = False                                'Texte pas en gras
                        rtsTableRow.FontSize = 10                               'Texte en taille 10
     
                Call rtitem.AppendTable(nbrow, nbcol)                           'Création du tableau avec nbrow lignes et nbcol colonnes
                Set rtnav = rtitem.CreateNavigator                              'Paramètre la variable de navigation dans le tableau
                'La navigation dans le tableau fonctionne comme ceci : balayage des cellules de gauche à droite en priorité, puis de haut en bas.
     
                Call rtitem.AppendStyle(rtsTableHeader)                         'Renseigne les en-têtes
                Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)              'Trouve la première cellule de mon tableau
                For iCol = 1 To nbcol Step 1
                    Call rtitem.BeginInsert(rtnav)                              'Insère un élément dans le tableau via rtnav
                    Call rtitem.AppendText(sHeaders(iCol - 1))
                    Call rtitem.EndInsert                                       'Arrête l'insertion de texte
                    Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)           'Va à la prochaine cellule de mon tableau
                Next
     
                Call rtitem.AppendStyle(rtsTableRow)                            'Renseigne les cellules du tableau
                For iRow = 1 To nbrow Step 1
                    For iCol = 1 To nbcol Step 1
                        Call rtitem.BeginInsert(rtnav)
                        If iCol = 1 Then Call rtitem.AppendText(Reference(iRow))
                        If iCol = 2 Then Call rtitem.AppendText(Defaut(iRow))
                        If iCol = 3 Then Call rtitem.AppendText(Action(iRow))
                        If iCol = 4 Then Call rtitem.AppendText(Cible(iRow))
                        Call rtitem.EndInsert
                        Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
                    Next
                Next
     
                'signature
                    Call rtitem.AddNewLine(1)
                    Call rtitem.AppendText("Cordialement,")
                    Call rtitem.AddNewLine(1)
                    Call rtitem.AppendText("Prenom Nom")
                    'Call rtitem.appendtext(Signature)
                    'Call rtitem.AddNewLine(2)
     
                MailDoc.SaveMessageOnSend = True                                 'Sauvegarde le mail envoyé
                MailDoc.PostedDate = Now()
                Call MailDoc.Save(True, False)
                MailDoc.Send 0                                                   'Envoie le mail
     
                Erase Reference                                                  'Initialise les variable tableau pour les mails des prochains contacts
                Erase Defaut
                Erase Action
                Erase Cible
    IterationSuivante:
            Next
    End Sub
    "Il est toujours plus facile de réaliser un travail que d'expliquer pourquoi on l'a fait." Martin Van Buren
    "Il y a ceux qui ont des résultats, et ceux qui ont des excuses." Moi

  2. #2
    Membre actif Avatar de pastis.vi
    Homme Profil pro
    Ingénieur qualité méthodes
    Inscrit en
    Novembre 2008
    Messages
    251
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Ingénieur qualité méthodes
    Secteur : Industrie

    Informations forums :
    Inscription : Novembre 2008
    Messages : 251
    Points : 209
    Points
    209
    Par défaut
    Rebonjour tout le monde,

    J'ai trouvé l'erreur ! En effet, le problème venait du fait que j'avais importé le code sur un nouveau document Excel. Le nouveau document n'avait donc pas les références Lotus.

    Le problème est donc résolu.
    "Il est toujours plus facile de réaliser un travail que d'expliquer pourquoi on l'a fait." Martin Van Buren
    "Il y a ceux qui ont des résultats, et ceux qui ont des excuses." Moi

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2007] Lien hypertexte dans un mail Lotus Notes
    Par pastis.vi dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 05/05/2015, 10h22
  2. Réponses: 0
    Dernier message: 28/03/2015, 13h53
  3. [VBA] Envoi mail lotus notes en utilisant un modèle
    Par Keelit95 dans le forum Macros et VBA Excel
    Réponses: 10
    Dernier message: 26/01/2010, 18h59
  4. comment inclure un tableau dans le CORPS d'un mail Lotus Notes
    Par Mathusalem dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 08/07/2008, 16h48
  5. JavaScript et mail Lotus Notes
    Par rdams dans le forum Autres langages pour le Web
    Réponses: 6
    Dernier message: 19/08/2005, 10h42

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo