Question

    type sale price    UPC code    Profit
      A    25         15116841635   2
      B    20         131313313 3   6 
      C    15          151651651    4
      D    10         55615613      3
      E    29         22222222      4
      A    22        1123333        4.4
      C    25        351313131     4.8
      D    25        131313131     5.2
      C    23         31331333     5.6
      E     23       51511352       6
      A     30       132323232     6.4
      B     80      3233213213     6.8
      A     47      3131311313     7.6


        Date        

        Total Sales (total dollar value)    
        Total units     "(Total units, each line is one unit)"  
        Total profit        

        A   (total units in A)  (total profit from A) 
        B   (total units in B)  (total profit from b)
        C            --                --
        D            --                 
        E            --                 --


                         Product A      
               Upc code    sale price   profit

              list broken by each product in A catagory     

                         Product B      
               Upc code   sale price    profit

                    and other types (max 6 - 10 ) 



              each sheet will have no more than 200 products daily so 
              i am thinking i can use specific cells like A200 as a 
              specific reference to start, i am not gonna have more than 
              200 lines. i am looking for vba code to put data into  
             above format, then  look for email address in another sheet 
             using sheet name and then email above created format only 
             to that person via outlook,

我想运行一个vba代码，如果可能的话，会在每张工作表中自动跟踪，

我有一张40张的excel书，每张都是我们个人商店的销售

列A是产品类型，只有5种类型

B栏是我们卖给它的美元价值

C列是产品upc代码

我希望vba创建一个具有

的电子邮件模板

该商店的总销售额
图表，显示每种类型的总销售量
图表，显示每种类型的总美元价值
分为5种产品的upc代码列表

通过电子邮件发送到商店，工作表名称是商店名称，我在另一张纸上有每个商店的电子邮件地址..我将每天收到报告

Answer 1

以下是一些可能对您有用的代码：

这里准备邮件

Sub EnvoiMail(Subject As String, Destina As String, Optional CCdest As String, Optional CCIdest As String, Optional BoDyTxt As String, Optional NbPJ As Integer, Optional PjPaths As String)
  Dim MonOutlook As Object
  Dim MonMessage As Object
  Set MonOutlook = CreateObject("Outlook.Application")
  Set MonMessage = MonOutlook.CreateItem(0)

  Dim PJ() As String
  PJ() = Split(PjPaths, ";")

  With MonMessage
      .Subject = Subject      ' "Je suis content"
      .To = Destina           ' "marcel@machin.com;julien@chose.com"
      .CC = CCdest            ' "chef@machin.com;directeur@chose.com"
      .BCC = CCIdest          ' "un.copain@supermail.com;une-amie@hotmail.com"
      .BoDy = BoDyTxt
        If PjPaths <> "" And NbPJ <> 0 Then
            For i = 0 To NbPJ - 1
                'MsgBox PJ(I)
              .Attachments.Add PJ(i)      '"C:\Mes Documents\Zoulie Image.gif"
            Next i
        End If
      .Display
  End With

  Set MonOutlook = Nothing
End Sub

这里有图表：

Sub Graph()

Dim Gr As Chart

        Set Gr = ActiveWorkbook.Charts.Add
            With Gr
            'Définition des données sources du graphique
            .SetSourceData Source:=Range(Sheets(Src_Name).Cells(2, 1), Sheets(Src_Name).Cells(20, 5)), PlotBy:=xlRows
            'Type de graphique
            .ChartType = xlXYScatterSmooth
            'Place
            .Location Where:=xlLocationAsNewSheet, Name:=NewSheetName
            'Titre
            .HasTitle = True
            .ChartTitle.Characters.Text = "Chart Title"
            'Séries de données
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Values = Range(Sheets(Src_Name).Cells(2, 2), Sheets(Src_Name).Cells(20, 5))
            .SeriesCollection(1).XValues = Range(Sheets(Src_Name).Cells(2, 1), Sheets(Src_Name).Cells(20, 1))
            .SeriesCollection(1).AxisGroup = 1
            .SeriesCollection(1).Name = "MTTF Calendaire"
            .SeriesCollection.NewSeries
            .SeriesCollection(2).Values = Range(Sheets(Src_Name).Cells(2, 2), Sheets(Src_Name).Cells(20, 5))
            .SeriesCollection(2).XValues = Range(Sheets(Src_Name).Cells(2, 1), Sheets(Src_Name).Cells(20, 1))
            .SeriesCollection(2).Name = "MTTR"
            .SeriesCollection(2).AxisGroup = 2
            .SeriesCollection(3).Delete
                        'épaisseur de la ligne tracée
                        .SeriesCollection(i).Format.Line.Weight = 1
                        'couleur des series
                        '.SeriesCollection(i).Format.Line.ForeColor.RGB = RGB(int1 as integer, int1 as integer, int3 as integer) ' pour une ligne
                        '.SeriesCollection(i).Format.Fill.ForeColor.RGB = RGB(int1 as integer, int1 as integer, int3 as integer) ' pour une area
            'Paramétrages des axes
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Age"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Heures"
            .PlotArea.Interior.ColorIndex = 2
            .Axes(xlValue).MajorGridlines.Border.LineStyle = xlDot
            .ChartArea.Font.Size = 14
            .Deselect
            End With

            'Placement de légende
            With ActiveChart.Legend
                .Left = 350
                .Top = 75
            End With
            'Placement des la zone de tracage
            With ActiveChart.PlotArea
                .Width = 550
                .Height = 350
            End With



'faire le ménage
Set Gr = Nothing



End Sub

如何在每张工作表中自动使用vba创建数据电子邮件模板，并将某些数据通过电子邮件发送给个人

1 个答案: