Autres outlook paragraph rnge move etc....

patricktoulon

XLDnaute Barbatruc
Bonjour a tous
je souhaiterait comprendre certaine fonctions dans le code mail avec outlook
notament les range paragraphe move etc ....
dans cet exemple j'ai un soucis avec move et insertafter la fin du message atterrit dans le tableau
si quelqu'un avait la gentillesse de m'expliquer ça serait sympatoche
merci d'avance
VB:
Option Explicit
Sub test4()

    Dim OutLK As Object, email As Object, wdDoc As Object, erreur%, rng As Object, plage(1 To 2) As Range, texte$(1 To 2)
    Dim TextePoli$, olMailItem&, textebyebye$
    With Sheets(1)
        Set plage(1) = .Range("A1:F10")
        Set plage(2) = .Range("C14:E22")
        TextePoli = "Bonjour veuillez trouver ci joint  les tableaux de relevé et synthèses"
        texte(1) = "Relevé d'informations des activités et incidents"
        texte(2) = "synthèse de la journée "
        textebyebye = "Vous souhaitant bonne réception" & vbNewLine & "Patrick:Responsable 16 ans et plus"
    End With

    'On Error Resume Next    'désactivation routine d'erreur
    erreur = False

    'Assignation des applications Outlook ,de l'objet email et du body de l'email en tant que document Word
    Set OutLK = CreateObject("outlook.application")
    Set email = OutLK.CreateItem(olMailItem)

    With email
        '....... remplissage sujet, objet, et adresse
        .To = "balabla@turlututu.fr"
        .CC = "trucbidule@chose.fr"
        .Subject = "relevé d'information et tableaux "
        .BodyFormat = 3   '2=html -- 3=olFormatRichText
        '....... corps du mail
        .Display
        Set wdDoc = email.GetInspector.WordEditor

        Set rng = wdDoc.Range(0, 0)
        ' Insertion avant la copie du tableau
        rng.InsertAfter TextePoli & vbNewLine & vbNewLine    'introduction

        '-------------------------------------------------------------------------
        'ajout du titre tableau 1
        rng.InsertAfter texte(1) & vbNewLine    'titre tableau 1
        'ok
        '-------------------------------------------------------------------------
        'ajout du tableau 1
        Set rng = rng.Paragraphs.Add().Range    'on ajoute un nouveau paragraphe
        '
        plage(1).Copy    ' Copie du tableau 1
        '
        ' collage au choix  en image ou tableau ou texte ou par (defaut tableau)
        rng.Paste                          'en tableau par defaut
        'rng.PasteSpecial , DataType:=1     'en tableau
        'rng.PasteSpecial , DataType:=2     'en texte "
        'rng.PasteSpecial , DataType:=4     'en metafichier "format WMF"

        rng.Move 1, 1   '????????? ' pas tres bien compris ce que ça veut dire exactement  )???????

        'tableau 1 Ok

        '-------------------------------------------------------------------------
        'ajout du titre tableau 2
        Set rng = rng.Paragraphs.Add().Range
        rng.InsertAfter texte(2) & vbNewLine
        'rng.Move X, y 'tel!! est la question ????????????
        '-------------------------------------------------------------------------


        '-------------------------------------------------------------------------
        'ajout du tableau 2

        Set rng = rng.Paragraphs.Add().Range
        ' Copie du tableau 2 et collage dans le newparagraphe .range
        plage(2).Copy   ' Copie du tableau2
        '
        ' collage au choix au choix en image ou tableau
        rng.Paste                                          ' en tableau
        'rng.PasteSpecial , DataType:=wdPasteMetafilePicture 'en metafichier "format WMF"

        'rng.Move X, y 'tel!! est la question ????????????
        '-------------------------------------------------------------------------

        '-------------------------------------------------------------------------
        'pied de page
        'Set rng = rng.Paragraphs.Add().Range    'on ajoute un nouveau paragraphe

        rng.InsertAfter textebyebye & vbNewLine & "Cordialement" & vbNewLine
        rng.Move 1, 200    ' pas tres bien compris ce que ça veut dire exactement  )

        'ici ca va plus !! il est soit dans la table 2 soit pas du tout
        '-------------------------------------------------------------------------

        '.Send     'Envoyer le message
        'If Err.Number <> 0 Then erreur = True
    End With

    'destruction des objets
    Set OutLK = Nothing: Set email = Nothing: Set wdDoc = Nothing

End Sub
 

Pièces jointes

  • test outlook.xlsm
    16.6 KB · Affichages: 3
C

Compte Supprimé 979

Guest
Salut Patrick

Voici les infos sur le "Move" ;)

Et voici le code corrigé
VB:
Sub TestBrunoM45()
  Dim OutLK As Object, email As Object, wdDoc As Object, erreur%, rng As Object, plage(1 To 2) As Range, texte$(1 To 2)
  Dim TextePoli$, olMailItem&, textebyebye$
  Dim StrRTF As String
  With Sheets(1)
    Set plage(1) = .Range("A1:F10")
    Set plage(2) = .Range("C14:E22")
    TextePoli = "Bonjour veuillez trouver ci joint  les tableaux de relevé et synthèses"
    texte(1) = "Relevé d'informations des activités et incidents"
    texte(2) = "synthèse de la journée "
    textebyebye = "Vous souhaitant bonne réception" & vbNewLine & "Patrick:Responsable 16 ans et plus"
  End With

  'On Error Resume Next    'désactivation routine d'erreur
  erreur = False

  'Assignation des applications Outlook ,de l'objet email et du body de l'email en tant que document Word
  Set OutLK = CreateObject("outlook.application")
  Set email = OutLK.CreateItem(olMailItem)

  With email
    '....... remplissage sujet, objet, et adresse
    .To = "balabla@turlututu.fr"
    .CC = "trucbidule@chose.fr"
    .Subject = "relevé d'information et tableaux "
    .BodyFormat = 3  '2=html -- 3=olFormatRichText
    '....... corps du mail
    .Display
    Set wdDoc = email.GetInspector.WordEditor
    ' Créer la première position des caractères
    Set rng = wdDoc.Range(0, 0)
    ' Insertion avant la copie du tableau
    rng.InsertAfter TextePoli & vbNewLine & vbNewLine    'introduction
    '-------------------------------------------------------------------------
    'ajout du titre tableau 1
    rng.InsertAfter texte(1) & vbNewLine    'titre tableau 1
    '-------------------------------------------------------------------------
    'ajout du tableau 1
    Set rng = rng.Paragraphs.Add().Range    'on ajoute un nouveau paragraphe
    plage(1).Copy    ' Copie du tableau 1
    '
    ' collage au choix  en image ou tableau ou texte ou par (defaut tableau)
    rng.Paste                          'en tableau par defaut
    'rng.PasteSpecial , DataType:=1     'en tableau
    'rng.PasteSpecial , DataType:=2     'en texte "
    'rng.PasteSpecial , DataType:=4     'en metafichier "format WMF"
    ' Déplacement d'unité
    ' https://docs.microsoft.com/fr-fr/office/vba/api/word.range.move
    rng.Move 1, 1   '????????? ' pas tres bien compris ce que ça veut dire exactement  )???????
    '
    '-------------------------------------------------------------------------
    'ajout du titre tableau 2
    Set rng = rng.Paragraphs.Add().Range
    rng.InsertAfter texte(2) & vbNewLine
    '-------------------------------------------------------------------------
    'ajout du tableau 2
    Set rng = rng.Paragraphs.Add().Range
    ' Copie du tableau 2 et collage dans le newparagraphe .range
    plage(2).Copy   ' Copie du tableau2
    '
    ' collage au choix au choix en image ou tableau
    rng.Paste                                          ' en tableau
    'rng.PasteSpecial , DataType:=wdPasteMetafilePicture 'en metafichier "format WMF"

    '-------------------------------------------------------------------------
    'pied de page
    Set rng = rng.Paragraphs.Add().Range    'on ajoute un nouveau paragraphe
    ' Déplacement de 1 (une) unité 2 fois
    ' https://docs.microsoft.com/fr-fr/office/vba/api/word.range.move
    rng.Move 1, 2
    rng.InsertAfter textebyebye & vbNewLine & "Cordialement" & vbNewLine
    '.Send     'Envoyer le message
    'If Err.Number <> 0 Then erreur = True
  End With

  'destruction des objets
  Set OutLK = Nothing: Set email = Nothing: Set wdDoc = Nothing

End Sub

Pas mal en RichText cela garde les couleurs du tableau 👍

A+
 

patricktoulon

XLDnaute Barbatruc
re
bonsoir @BrunoM45
oui même en html aussi format 2 les couleur des tableaux restent
je m’étais débrouillé autrement

en fait j'ajoute un paragraphe pour chaque truc que ce soit une table ou du texte
et je move(1,1)

le seul problème avec richtexte pour formater le texte je ne sais pas faire

alors je reste en format 2 html et a la fin je fait un replace sur les "&lt;" et le " &gt;

seul problème là ca change les couleur

que cela te tienne je paste les tables en metafile sauf que là, ben c'est les caractères qui ne sont pas modifier il mélange le innerhtml avec le innertext


donc
1° si je colle les table en html (par defaut) ou datatype 1mes textes sont bons mais ca me change un peu les couleurs dans les tables

2° si je colle en metafile ('rng.PasteSpecial , DataType:=4)c'est le inner qui déconne

regarde
VB:
Option Explicit
Sub test4()

    Dim OutLK As Object, email As Object, wdDoc As Object, erreur%, rng As Object, plage(1 To 2) As Range, texte$(1 To 2)
    Dim TextePoli$, olMailItem&, textebyebye$
    With Sheets(1)
        Set plage(1) = .Range("A1:F10")
        Set plage(2) = .Range("C14:E22")
        TextePoli = "Bonjour veuillez trouver ci joint  les tableaux de relevé et synthèses"
        texte(1) = "<H3><font color = green>Relevé d'informations des <i>activités</i> et <i>incidents</i></font></H3>"
        texte(2) = "<H3><font color=orange>synthèse: de la journée</font></H3>"
        textebyebye = "En vous souhaitant bonne réception" & vbNewLine & _
                      "<font color=blue face=algerian>Patrick</font>:<font color=orange ><i><b> Responsable 16 ans et plus</b></i></font>"
    End With

    'On Error Resume Next    'désactivation routine d'erreur
    erreur = False

    'Assignation des applications Outlook ,de l'objet email et du body de l'email en tant que document Word
    Set OutLK = CreateObject("outlook.application")
    Set email = OutLK.CreateItem(olMailItem)

    With email
        '....... remplissage sujet, objet, et adresse
        .To = "balabla@turlututu.fr"
        .CC = "trucbidule@chose.fr"
        .Subject = "relevé d'information et tableaux "
        .BodyFormat = 2   '2=html -- 3=olFormatRichText
        '....... corps du mail
        .Display
        Set wdDoc = email.GetInspector.WordEditor

        Set rng = wdDoc.Range(0, 0)
        ' Insertion avant la copie du tableau
        rng.InsertAfter TextePoli & vbNewLine & vbNewLine    'introduction

        '-------------------------------------------------------------------------
        'ajout du titre tableau 1
        rng.InsertAfter texte(1) & vbNewLine    'titre tableau 1
        'ok
        '-------------------------------------------------------------------------
        'ajout du tableau 1
        Set rng = rng.Paragraphs.Add().Range    'on ajoute un nouveau paragraphe
        '
        plage(1).Copy    ' Copie du tableau 1
        '
        ' collage au choix  en image ou tableau ou texte ou par (defaut tableau)
        'rng.Paste                          'en tableau par defaut
        rng.PasteSpecial , DataType:=1     'en tableau
        'rng.PasteSpecial , DataType:=2     'en texte "
        'rng.PasteSpecial , DataType:=4     'en metafichier "format WMF"

        rng.Move 1, 1  '????????? ' pas tres bien compris ce que ça veut dire exactement  )???????

        'tableau 1 Ok

        '-------------------------------------------------------------------------
        'ajout du titre tableau 2
        Set rng = rng.Paragraphs.Add().Range
        rng.InsertAfter texte(2) & vbNewLine
        rng.Move 1, 1    'tel!! est la question ????????????
        '-------------------------------------------------------------------------


        '-------------------------------------------------------------------------
        'ajout du tableau 2

        Set rng = rng.Paragraphs.Add().Range
        ' Copie du tableau 2 et collage dans le newparagraphe .range
        plage(2).Copy   ' Copie du tableau2
        '
        'collage au choix au choix en image ou tableau
        'rng.Paste                          'en tableau par defaut
        rng.PasteSpecial , DataType:=1     'en tableau
        'rng.PasteSpecial , DataType:=2     'en texte "
        'rng.PasteSpecial , DataType:=4     'en metafichier "format WMF"

        rng.Move 1, 1    'tel!! est la question ????????????
        '-------------------------------------------------------------------------

        '-------------------------------------------------------------------------
        'pied de page
        Set rng = rng.Paragraphs.Add().Range    'on ajoute un nouveau paragraphe

        rng.InsertAfter textebyebye & vbNewLine & "Cordialement" & vbNewLine
        rng.Move 1, 1   ' pas tres bien compris ce que ça veut dire exactement  )

        'ici ca va plus !! il est soit dans la table 2 soit pas du tout
        '-------------------------------------------------------------------------

        '.Send     'Envoyer le message
        'If Err.Number <> 0 Then erreur = True
        .htmlbody = Replace(Replace(.htmlbody, "&lt;", "<"), "&gt;", ">")
        Debug.Print .htmlbody

    End With

    'destruction des objets
    Set OutLK = Nothing: Set email = Nothing: Set wdDoc = Nothing

End Sub
si tu sais comment on peut arranger le texte(couleur font etc... par vba ca m'arrangerait
merci pour ton retour
 
C

Compte Supprimé 979

Guest
Re,

Au début du code, est-ce que cela pourrait t'aller 🤔
VB:
    ' Créer la première position des caractères
    Set rng = wdDoc.Range(0, 0)
    ' Insertion avant la copie du tableau
    rng.InsertAfter TextePoli & vbNewLine & vbNewLine    'introduction
    rng.HighlightColorIndex = 3 ' wdTurquoise
    rng.Font.Bold = True
    rng.Font.Size = 18

A+
 

patricktoulon

XLDnaute Barbatruc
j'ai trouvé c'est comm en JS en fait

VB:
rng.InsertAfter TextePoli & vbNewLine & vbNewLine    'introduction
        rng.HighlightColorIndex = 3    ' wdTurquoise
        rng.Font.Bold = True
        rng.Font.Size = 18
        rng.Font.Name = "algerian"
        wdDoc.Range(0, 8).Font.Color = vbRed    'le bonjour en rouge
        wdDoc.Range(17, 24).Font.Color = vbYellow    'le trouver en jaune
il va falloir que j'invente encore un code pour faire ça piloté
 

Discussions similaires