ОбъемВыпуска:=CALCULATE(SUM('qProduced'[Количество]);  'qProduced'[Артикул] =  EARLIER('qSalesCost'[Артикул]); 'qProduced'[Дата выпуска]  = EARLIER('qSalesCost'[Дата реализации]))

<?xml version="1.0" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
   <ribbon startFromScratch="false">
      <tabs>
         <tab id="PanelFirst" label="ПАНЕЛЬ №1" visible ="false">
         </tab>
                  
         <tab id="PanelSecond" label="ПАНЕЛЬ №2" visible ="false">
         </tab>
         
         <tab id="EnterTab" label="ВХОД В ПРОГРАММУ">
            <group id="grEnterTab" label="ВХОД В ПРОГРАММУ">
                  <button id ="btnEnter" label="ВХОД В ПРОГРАММУ" onAction="CRMEnter"/>
            </group>
         </tab>
      </tabs>
   </ribbon>
</customUI> 

Option Explicit

Sub CRMEnter(ByRef control As IRibbonControl)
   Application.ThisWorkbook.CommandBars("PanelFirst").Visible = True
   Application.ThisWorkbook.CommandBars("PanelSecond").Visible = True
End Sub

Private Sub AddinsActivate()
Dim sAddinName$
Dim ws As Worksheet

On Error Resume Next

Application.ScreenUpdating = False
ThisWorkbook.IsAddin = False
Application.DisplayAlerts = False

sAddinName = ThisWorkbook.Name

'преобразование надстройки в файл
Workbooks(sAddinName).Windows(1).Visible = False

'переборка листов в новом файле, если будут листы с похожим наименованием
For Each ws In ActiveWorkbook.Sheets
    If VBA.LCase(ws.Name) Like "*ффф*" Then ws.Delete
Next

Workbooks(sAddinName).Worksheets("ФФФ").Copy _
After:=ActiveWorkbook.Sheets(1)

ThisWorkbook.IsAddin = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub PopulateMassiv()
Dim a, i, j, k As Integer
Dim strA, strB, strC As String
Dim arrA, arrB(), arrVar, c, b As Variant

arrA = Array("Юг Итого", "Восток Итого", "Запад Итого")
b = 0
c = 0
i = 0

For a = 0 To UBound(arrA)
    Do While Worksheets("Запасы").Cells(4 + b, 2).Value <> arrA(a)    
        If Worksheets("Запасы").Cells(4 + b, 2).Value = arrA(a) Then
            b = b + 3
        
            ElseIf Right(Worksheets("Запасы").Cells(4 + b, 2).Value, 5) = "Итого" Then
            b = b + 2
            
            Else 
        End If
        
        Do While Right(Worksheets("Запасы").Cells(4 + b, 2).Value, 5) <> "Итого"
            'strA = Worksheets("Çàïàñû").Cells(4 + b, 2).Value
            j = j + 1
            b = b + 1
        Loop
    
        ReDim Preserve arrB(a, 0 To 4)
        arrB(a, i) = j - 1
                        
        i = i + 1
        b = b + 1
        j = 0   
    Loop
        
    a = a + 1
Next a
End Sub

Sub ChartCreat()    
Dim RowNum, ValCount, i As Integer

RowNum = 7
ValCount = 1
Range("S21").Select
ActiveSheet.ChartObjects.Add(840, 350, 600, 250).Select
ActiveChart.ChartType = xlColumnStacked

ActiveChart.SeriesCollection(1).Values = Range("U" & RowNum & ":" & "U" & (RowNum + 1) & ",U" & (RowNum + 13))  'В ЭТОЙ СТРОКЕ ПОЯВЛЯЕТСЯ СООБЩЕНИЕ
ActiveChart.SeriesCollection(2).Values = Range("V" & RowNum & ":" & "V" & (RowNum + 1) & ",V" & (RowNum + 13))
ActiveChart.SeriesCollection(3).Values = Range("W" & RowNum & ":" & "W" & (RowNum + 1) & ",W" & (RowNum + 13))
ActiveChart.SeriesCollection(3).XValues = Range("S" & RowNum & ":" & "S" & (RowNum + 1) & ",S" & (RowNum + 13))

With ActiveChart.SeriesCollection(1).Points(2).Format
        .Fill.Visible = 0
        .Line.Visible = 0
        .Shadow.Visible = False
       
End With
End Sub

Sub DataLabels()
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    With ActiveChart.SeriesCollection(1).DataLabels
        With .Font
            .Name = "Times New Roman"
            .Size = 10
            .Bold = msoTrue
        End With
        .Position = xlLabelPositionAbove
        .NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    End With
End Sub