Help script VBA

Résolu
Mon6760 Messages postés 3 Statut Membre -  
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

Je suis actuellement en train de coder pour essayer de créer un mail. Je vous explique, chaque semaine je dois faire un rapport a partir d'un ficher Excel sous forme de mail. Je voudrais me faciliter la vie en créant la forme du mail. J'ai réussi a le faire en sélectionnant une ligne mais je n'y arrive pas avec tout le fichier... De plus je voudrait additionner les "Amount" qui on les mêmes références. Pouvez-vous m'aider ou me donner des pistes ? Merci

Sub Mail_Workbook_1()

Dim Type As String
Dim Region As String
Dim Impact As String
Dim Reference As String
Dim JourdeCreation As String
Dim SumEUR As String
Dim Amount As String

Dim FL As Worksheet              'stocker la valeur du classeur actif
Dim LineNB, ColNB As Long        'récupérer la ligne sélectionnée

Set FL = Worksheets("Weekly")
Set FL = ActiveSheet
LineNB = ActiveCell.Row

Type = FL.Cells(LineNB, 9)
Region = FL.Cells(LineNB, 4)
Impact = FL.Cells(LineNB, 7)
Reference = FL.Cells(LineNB, 2)
JourdeHICreation = FL.Cells(LineNB, 10)
SumEUR = FL.Cells(LineNB, 1)
Amount = FL.Cells(LineNB, 11)
    
    Dim OutApp As Object
    Dim OutMail As Object


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = Reference & " " & "(" & JourdeHICreation & "/" & " " & "/" & Type & "/" & "EUR " & Amount & " K" & ")"
           
        .Display
    
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub



3 réponses

  1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonsoir, une piste:
    Option Explicit
    
    Sub Mail_Workbook_1()
    Dim Tyype As String
    Dim Region As String
    Dim Impact As String
    Dim Reference As String
    Dim JourdeHICreation As String
    Dim SumEUR As String
    Dim Amount As String
    Dim textemsg As String
    Dim lig As Range
    Dim FL As Worksheet              'stocker la valeur du classeur actif
     Dim OutApp As Object
        Dim OutMail As Object
    Set FL = Worksheets("Weekly")
    For Each lig In FL.UsedRange.Rows
        Tyype = lig(1, 9)
        Region = lig(1, 4)
        Impact = lig(1, 7)
        Reference = lig(1, 2)
        JourdeHICreation = lig(1, 10)
        SumEUR = lig(1, 1)
        Amount = lig(1, 11)
        textemsg = textemsg _
            & Reference & " " & "(" & JourdeHICreation & "/" & " " & "/" & Tyype & "/" & "EUR " & Amount & " K" & ")"
    Next lig
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = ""
            .Body = textemsg
            .Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
    End Sub
    0
  2. Mon6760 Messages postés 3 Statut Membre
     
    Merci bcp, effectivement c'est plus logique comme cela. Le problème est que je n'arrive pas a récupérer la valeur des autres lignes... j'ai essayer ca:

    Option Explicit
    Sub Mail_Workbook_1()

    Dim Tyype As String
    Dim Region As String
    Dim Impact As String
    Dim Reference As String
    Dim JourdeCreation As String
    Dim SumEUR As String
    Dim Amount As String

    Dim LineNB, ColNB As Long

    Dim textemsg As String
    Dim lig As Range
    Dim FL As Worksheet 'stocker la valeur du classeur actif

    Set FL = Worksheets("Weekly_breakdown_crosstab")

    LineNB = ActiveCell.Row

    For Each lig In FL.UsedRange.Rows

    Tyype = FL.Cells(LineNB, 9).Value
    Region = FL.Cells(LineNB, 4).Value
    Impact = FL.Cells(LineNB, 8).Value
    Reference = FL.Cells(LineNB, 2).Value
    JourdeCreation = FL.Cells(LineNB, 10).Value
    SumEUR = FL.Cells(LineNB, 1).Value
    Amount = FL.Cells(LineNB, 11).Value

    textemsg = textemsg _
    & Reference & " " & "(" &JourdeCreation& "/" & " " & "/" & Impact & "/" & "EUR " & Amount & ")"

    Next lig

    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    With OutMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = ""
    .Body = textemsg
    .Display

    End With

    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

    End Sub



    Mais cela ne sélectionne que la ligne et l'écrit plusieurs fois...

    Merci beaucoup pour votre aide!
    0
  3. Mon6760 Messages postés 3 Statut Membre
     
    J'ai reussi, merci bcp pour la piste !
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      super! peux-tu alors marquer le sujet comme résolu, via la roue dentée à droite du titre?
      0