Help script VBA

Résolu
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. Contributeur
    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
    1. 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!
      1. J'ai reussi, merci bcp pour la piste !
        1. Contributeur
          super! peux-tu alors marquer le sujet comme résolu, via la roue dentée à droite du titre?