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. 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?
  2. 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. 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